+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
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;
--------------
(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;
--------------
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;
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;
--------------
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;
-- 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;
--------------
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;
--------------
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;
--------------
----------------
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;
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;
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
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 --
--------------------
-- 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 --
----------------------------------
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 --
----------------------------
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 --
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;
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
-- 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
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);
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;
-- 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
pragma Assert (False);
null;
- when Runnable =>
+ when Activating | Runnable =>
+
-- This is needed to cancel an asynchronous protected entry
-- call during a requeue with abort.
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);
-- 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.
Previous := Null_Task;
C := All_Tasks_List;
-
while C /= Null_Task loop
if C = T then
if Previous = Null_Task then
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;
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));
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);
-----------------------
-- 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);
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;
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;
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);
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
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.)
-- 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
-- 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 --
----------------------------------------------
-- 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;
---------------------------------------
-- 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
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,
end if;
STPO.Timed_Sleep (Self_Id, Timeout, Mode,
- Acceptor_Sleep, Timedout, Yielded);
+ Acceptor_Delay_Sleep, Timedout, Yielded);
end if;
if Timedout then
-- 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;
-- 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;
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);
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,
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
-- 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
projects / thirdparty / gcc.git / commitdiff
