Commit 3204b9cd by Arnaud Charlet

[multiple changes]

2009-04-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Map_Formal_Package_Entities): renamed from Map_Entities
	and made global, to be used when installing parents of a child
	instance, to provide mappings for entities declared in formal packages
	of ancestor units. Now called from Install_Formal_Packages.

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

	* s-taskin.adb (Initialize_ATCB): Initialize Debug_Events with others
	notation for clarity.

	* s-taprop-vxworks.adb, s-taprop-tru64.adb, s-taprop-vms.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
	(Initialize): Initialize Known_Tasks with Environment task.

	* s-taskin.ads (Task_States): Move new states to end for the sake of
	GDB compatibility.

	* s-tassta.adb (Task_Wrapper): Fix comment about Enter_Task.

From-SVN: r146158
parent f17f3601
2009-04-16 Ed Schonberg <schonberg@adacore.com> 2009-04-16 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Map_Formal_Package_Entities): renamed from Map_Entities
and made global, to be used when installing parents of a child
instance, to provide mappings for entities declared in formal packages
of ancestor units. Now called from Install_Formal_Packages.
2009-04-16 Doug Rupp <rupp@adacore.com>
* s-taskin.adb (Initialize_ATCB): Initialize Debug_Events with others
notation for clarity.
* s-taprop-vxworks.adb, s-taprop-tru64.adb, s-taprop-vms.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
(Initialize): Initialize Known_Tasks with Environment task.
* s-taskin.ads (Task_States): Move new states to end for the sake of
GDB compatibility.
* s-tassta.adb (Task_Wrapper): Fix comment about Enter_Task.
2009-04-16 Ed Schonberg <schonberg@adacore.com>
* exp_ch9.adb (Expand_N_Protected_Type_Declaration): If a protected * exp_ch9.adb (Expand_N_Protected_Type_Declaration): If a protected
operation has an inline pragma, propagate the flag to the internal operation has an inline pragma, propagate the flag to the internal
unprotected subprogram. unprotected subprogram.
...@@ -1218,6 +1218,12 @@ package body System.Task_Primitives.Operations is ...@@ -1218,6 +1218,12 @@ package body System.Task_Primitives.Operations is
Specific.Initialize (Environment_Task); Specific.Initialize (Environment_Task);
-- Make environment task known here because it doesn't go through
-- Activate_Tasks, which does it for all other tasks.
Known_Tasks (Known_Tasks'First) := Environment_Task;
Environment_Task.Known_Tasks_Index := Known_Tasks'First;
Enter_Task (Environment_Task); Enter_Task (Environment_Task);
-- Install the abort-signal handler -- Install the abort-signal handler
......
...@@ -1303,6 +1303,12 @@ package body System.Task_Primitives.Operations is ...@@ -1303,6 +1303,12 @@ package body System.Task_Primitives.Operations is
Specific.Initialize (Environment_Task); Specific.Initialize (Environment_Task);
-- Make environment task known here because it doesn't go through
-- Activate_Tasks, which does it for all other tasks.
Known_Tasks (Known_Tasks'First) := Environment_Task;
Environment_Task.Known_Tasks_Index := Known_Tasks'First;
Enter_Task (Environment_Task); Enter_Task (Environment_Task);
-- Prepare the set of signals that should unblocked in all tasks -- Prepare the set of signals that should unblocked in all tasks
......
...@@ -1244,6 +1244,12 @@ package body System.Task_Primitives.Operations is ...@@ -1244,6 +1244,12 @@ package body System.Task_Primitives.Operations is
Alternate_Stack'Address; Alternate_Stack'Address;
end if; end if;
-- Make environment task known here because it doesn't go through
-- Activate_Tasks, which does it for all other tasks.
Known_Tasks (Known_Tasks'First) := Environment_Task;
Environment_Task.Known_Tasks_Index := Known_Tasks'First;
Enter_Task (Environment_Task); Enter_Task (Environment_Task);
-- Install the abort-signal handler -- Install the abort-signal handler
......
...@@ -1069,6 +1069,13 @@ package body System.Task_Primitives.Operations is ...@@ -1069,6 +1069,13 @@ package body System.Task_Primitives.Operations is
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
Environment_Task.Common.LL.Thread := GetCurrentThread; Environment_Task.Common.LL.Thread := GetCurrentThread;
-- Make environment task known here because it doesn't go through
-- Activate_Tasks, which does it for all other tasks.
Known_Tasks (Known_Tasks'First) := Environment_Task;
Environment_Task.Known_Tasks_Index := Known_Tasks'First;
Enter_Task (Environment_Task); Enter_Task (Environment_Task);
end Initialize; end Initialize;
......
...@@ -1423,6 +1423,12 @@ package body System.Task_Primitives.Operations is ...@@ -1423,6 +1423,12 @@ package body System.Task_Primitives.Operations is
Alternate_Stack'Address; Alternate_Stack'Address;
end if; end if;
-- Make environment task known here because it doesn't go through
-- Activate_Tasks, which does it for all other tasks.
Known_Tasks (Known_Tasks'First) := Environment_Task;
Environment_Task.Known_Tasks_Index := Known_Tasks'First;
Enter_Task (Environment_Task); Enter_Task (Environment_Task);
-- Install the abort-signal handler -- Install the abort-signal handler
......
...@@ -479,6 +479,12 @@ package body System.Task_Primitives.Operations is ...@@ -479,6 +479,12 @@ package body System.Task_Primitives.Operations is
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
-- Make environment task known here because it doesn't go through
-- Activate_Tasks, which does it for all other tasks.
Known_Tasks (Known_Tasks'First) := Environment_Task;
Environment_Task.Known_Tasks_Index := Known_Tasks'First;
Enter_Task (Environment_Task); Enter_Task (Environment_Task);
-- Install the abort-signal handler -- Install the abort-signal handler
......
...@@ -1332,6 +1332,12 @@ package body System.Task_Primitives.Operations is ...@@ -1332,6 +1332,12 @@ package body System.Task_Primitives.Operations is
Specific.Initialize (Environment_Task); Specific.Initialize (Environment_Task);
-- Make environment task known here because it doesn't go through
-- Activate_Tasks, which does it for all other tasks.
Known_Tasks (Known_Tasks'First) := Environment_Task;
Environment_Task.Known_Tasks_Index := Known_Tasks'First;
Enter_Task (Environment_Task); Enter_Task (Environment_Task);
-- Install the abort-signal handler -- Install the abort-signal handler
......
...@@ -1264,6 +1264,12 @@ package body System.Task_Primitives.Operations is ...@@ -1264,6 +1264,12 @@ package body System.Task_Primitives.Operations is
0 -- False, we don't have the std TCB prolog 0 -- False, we don't have the std TCB prolog
); );
-- Make environment task known here because it doesn't go through
-- Activate_Tasks, which does it for all other tasks.
Known_Tasks (Known_Tasks'First) := Environment_Task;
Environment_Task.Known_Tasks_Index := Known_Tasks'First;
Enter_Task (Environment_Task); Enter_Task (Environment_Task);
end Initialize; end Initialize;
......
...@@ -1383,6 +1383,12 @@ package body System.Task_Primitives.Operations is ...@@ -1383,6 +1383,12 @@ package body System.Task_Primitives.Operations is
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
-- Make environment task known here because it doesn't go through
-- Activate_Tasks, which does it for all other tasks.
Known_Tasks (Known_Tasks'First) := Environment_Task;
Environment_Task.Known_Tasks_Index := Known_Tasks'First;
Enter_Task (Environment_Task); Enter_Task (Environment_Task);
end Initialize; end Initialize;
......
...@@ -114,25 +114,25 @@ package body System.Tasking is ...@@ -114,25 +114,25 @@ package body System.Tasking is
return; return;
end if; end if;
T.Common.Parent := Parent; -- Wouldn't the following be better done using an assignment of an
T.Common.Base_Priority := Base_Priority; -- aggregate so that we could be sure no components were forgotten???
T.Common.Current_Priority := 0;
T.Common.Parent := Parent;
T.Common.Base_Priority := Base_Priority;
T.Common.Current_Priority := 0;
T.Common.Protected_Action_Nesting := 0; T.Common.Protected_Action_Nesting := 0;
T.Common.Call := null; T.Common.Call := null;
T.Common.Task_Arg := Task_Arg; T.Common.Task_Arg := Task_Arg;
T.Common.Task_Entry_Point := Task_Entry_Point; T.Common.Task_Entry_Point := Task_Entry_Point;
T.Common.Activator := Self_ID; T.Common.Activator := Self_ID;
T.Common.Wait_Count := 0; T.Common.Wait_Count := 0;
T.Common.Elaborated := Elaborated; T.Common.Elaborated := Elaborated;
T.Common.Activation_Failed := False; T.Common.Activation_Failed := False;
T.Common.Task_Info := Task_Info; T.Common.Task_Info := Task_Info;
T.Common.Global_Task_Lock_Nesting := 0; T.Common.Global_Task_Lock_Nesting := 0;
T.Common.Fall_Back_Handler := null; T.Common.Fall_Back_Handler := null;
T.Common.Specific_Handler := null; T.Common.Specific_Handler := null;
T.Common.Debug_Events := T.Common.Debug_Events := (others => False);
(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 if T.Common.Parent = null then
......
...@@ -131,8 +131,9 @@ package System.Tasking is ...@@ -131,8 +131,9 @@ package System.Tasking is
-- TCB initialized but not task has not been created. -- TCB initialized but not task has not been created.
-- It cannot be executing. -- It cannot be executing.
Activating, -- Activating,
-- Task has been created and is being made Runnable. -- -- ??? Temporarily at end of list for GDB compatibility
-- -- Task has been created and is being made Runnable.
-- Active states -- Active states
-- For all states from here down, the task has been activated. -- For all states from here down, the task has been activated.
...@@ -156,8 +157,9 @@ package System.Tasking is ...@@ -156,8 +157,9 @@ package System.Tasking is
Acceptor_Sleep, Acceptor_Sleep,
-- Task is waiting on an accept or select with terminate -- Task is waiting on an accept or select with terminate
Acceptor_Delay_Sleep, -- Acceptor_Delay_Sleep,
-- Task is waiting on an selective wait statement -- -- ??? Temporarily at end of list for GDB compatibility
-- -- Task is waiting on an selective wait statement
Entry_Caller_Sleep, Entry_Caller_Sleep,
-- Task is waiting on an entry call -- Task is waiting on an entry call
...@@ -193,9 +195,15 @@ package System.Tasking is ...@@ -193,9 +195,15 @@ package System.Tasking is
Asynchronous_Hold, Asynchronous_Hold,
-- The task has been held by Asynchronous_Task_Control.Hold_Task -- The task has been held by Asynchronous_Task_Control.Hold_Task
Interrupt_Server_Blocked_On_Event_Flag Interrupt_Server_Blocked_On_Event_Flag,
-- The task has been blocked on a system call waiting for a -- The task has been blocked on a system call waiting for a
-- completion event/signal to occur. -- completion event/signal to occur.
Activating,
-- Task has been created and is being made Runnable.
Acceptor_Delay_Sleep
-- Task is waiting on an selective wait statement
); );
type Call_Modes is type Call_Modes is
......
...@@ -1111,8 +1111,7 @@ package body System.Tasking.Stages is ...@@ -1111,8 +1111,7 @@ package body System.Tasking.Stages is
Stack_Guard (Self_ID, True); Stack_Guard (Self_ID, True);
-- Initialize low-level TCB components, that cannot be initialized by -- Initialize low-level TCB components, that cannot be initialized by
-- the creator. Enter_Task sets Self_ID.Known_Tasks_Index and also -- the creator. Enter_Task sets Self_ID.LL.Thread
-- Self_ID.LL.Thread
Enter_Task (Self_ID); Enter_Task (Self_ID);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment