with Ada.Exceptions;
with Ada.Unchecked_Deallocation;
+with System.Interrupt_Management;
with System.Tasking.Debug;
with System.Address_Image;
with System.Task_Primitives;
Write_Lock (P);
Write_Lock (C);
- if C.Common.Base_Priority < Get_Priority (Self_ID) then
- Activate_Prio := Get_Priority (Self_ID);
- else
- Activate_Prio := C.Common.Base_Priority;
- end if;
+ Activate_Prio :=
+ (if C.Common.Base_Priority < Get_Priority (Self_ID)
+ then Get_Priority (Self_ID)
+ else C.Common.Base_Priority);
System.Task_Primitives.Operations.Create_Task
(C, Task_Wrapper'Address,
-- 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);
raise Program_Error with "potentially blocking operation";
end if;
- pragma Debug
- (Debug.Trace (Self_ID, "Create_Task", 'C'));
+ pragma Debug (Debug.Trace (Self_ID, "Create_Task", 'C'));
- if Priority = Unspecified_Priority then
- Base_Priority := Self_ID.Common.Base_Priority;
- else
- Base_Priority := System.Any_Priority (Priority);
- end if;
+ Base_Priority :=
+ (if Priority = Unspecified_Priority
+ then Self_ID.Common.Base_Priority
+ else System.Any_Priority (Priority));
-- Find parent P of new Task, via master level number
-- confused when waiting for these tasks to terminate.
T.Master_of_Task := Library_Task_Level;
+
else
T.Master_of_Task := Master;
end if;
T.Common.Task_Image_Len := Len;
end if;
+ Unlock (Self_ID);
+ Unlock_RTS;
+
+ -- Note: we should not call 'new' while holding locks since new
+ -- may use locks (e.g. RTS_Lock under Windows) itself and cause a
+ -- deadlock.
+
if Build_Entry_Names then
T.Entry_Names :=
new Entry_Names_Array (1 .. Entry_Index (Num_Entries));
end if;
- Unlock (Self_ID);
- Unlock_RTS;
-
-- Create TSD as early as possible in the creation of a task, since it
-- may be used by the operation of Ada code within the task.
Ignore : Boolean;
pragma Unreferenced (Ignore);
+ function State
+ (Int : System.Interrupt_Management.Interrupt_ID) return Character;
+ pragma Import (C, State, "__gnat_get_interrupt_state");
+ -- Get interrupt state for interrupt number Int. Defined in init.c
+
+ Default : constant Character := 's';
+ -- 's' Interrupt_State pragma set state to System (use "default"
+ -- system handler)
+
begin
if Self_ID.Deferral_Level = 0 then
-- ???
Write_Lock (Self_ID);
- loop
- exit when Utilities.Independent_Task_Count = 0;
+ -- If the Abort_Task signal is set to system, it means that we may not
+ -- have been able to abort all independent tasks (in particular
+ -- Server_Task may be blocked, waiting for a signal), in which case,
+ -- do not wait for Independent_Task_Count to go down to 0.
- -- We used to yield here, but this did not take into account low
- -- priority tasks that would cause dead lock in some cases (true
- -- FIFO scheduling).
+ if State
+ (System.Interrupt_Management.Abort_Task_Interrupt) /= Default
+ then
+ loop
+ exit when Utilities.Independent_Task_Count = 0;
- Timed_Sleep
- (Self_ID, 0.01, System.OS_Primitives.Relative,
- Self_ID.Common.State, Ignore, Ignore);
- end loop;
+ -- We used to yield here, but this did not take into account low
+ -- priority tasks that would cause dead lock in some cases (true
+ -- FIFO scheduling).
+
+ Timed_Sleep
+ (Self_ID, 0.01, System.OS_Primitives.Relative,
+ Self_ID.Common.State, Ignore, Ignore);
+ end loop;
+ end if;
-- ??? On multi-processor environments, it seems that the above loop
-- isn't sufficient, so we need to add an additional delay.
Initialization.Undefer_Abort (Self_ID);
end Move_Activation_Chain;
- -- Compiler interface only. Do not call from within the RTS.
+ -- Compiler interface only. Do not call from within the RTS
--------------------
-- Set_Entry_Name --
-- Assume a size of the stack taken at this stage
- if Size < Small_Stack_Limit then
- Overflow_Guard := Small_Overflow_Guard;
- else
- Overflow_Guard := Big_Overflow_Guard;
- end if;
+ Overflow_Guard :=
+ (if Size < Small_Stack_Limit
+ then Small_Overflow_Guard
+ else Big_Overflow_Guard);
if not Parameters.Sec_Stack_Dynamic then
Self_ID.Common.Compiler_Data.Sec_Stack_Addr :=
Stack_Guard (Self_ID, True);
-- Initialize low-level TCB components, that cannot be initialized by
- -- the creator. Enter_Task sets Self_ID.Known_Tasks_Index and also
- -- Self_ID.LL.Thread
+ -- the creator. Enter_Task sets Self_ID.LL.Thread
Enter_Task (Self_ID);
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
T := To_Be_Freed;
To_Be_Freed := T.Common.All_Tasks_Link;
- -- ??? On SGI there is currently no Interrupt_Manager, that's
- -- why we need to check if the Interrupt_Manager_ID is null
+ -- ??? On SGI there is currently no Interrupt_Manager, that's why we
+ -- need to check if the Interrupt_Manager_ID is null.
- if T.Interrupt_Entry and Interrupt_Manager_ID /= null then
+ if T.Interrupt_Entry and then Interrupt_Manager_ID /= null then
declare
Detach_Interrupt_Entries_Index : constant Task_Entry_Index := 1;
-- Corresponds to the entry index of System.Interrupts.
OSDN Git Service
