diff --git a/src/polyorb-orb.adb b/src/polyorb-orb.adb index a9fcddae8..d720390a4 100644 --- a/src/polyorb-orb.adb +++ b/src/polyorb-orb.adb @@ -348,6 +348,10 @@ package body PolyORB.ORB is -- re-assert it before returning. Idle (ORB.Tasking_Policy, This_Task, ORB_Access (ORB)); + Notify_Event + (ORB.ORB_Controller, + Event'(Kind => Idle_Awake, + Awakened_Task => This_Task'Unchecked_Access)); when Terminated => @@ -397,7 +401,7 @@ package body PolyORB.ORB is Exit_Condition.Task_Info.all := null; end if; - Set_State_Unscheduled (This_Task); + Set_State_Terminated (This_Task); Unregister_Task (ORB.ORB_Controller, This_Task'Unchecked_Access); raise; diff --git a/src/polyorb-orb_controller-basic.adb b/src/polyorb-orb_controller-basic.adb index 8725993f3..2e73e85da 100644 --- a/src/polyorb-orb_controller-basic.adb +++ b/src/polyorb-orb_controller-basic.adb @@ -311,6 +311,13 @@ package body PolyORB.ORB_Controller.Basic is null; end case; + + when Idle_Awake => + + -- A task has left Idle state + + List_Detach (E.Awakened_Task.all, O.Idle_Task_List); + end case; pragma Debug (O2 (Status (O))); @@ -325,7 +332,7 @@ package body PolyORB.ORB_Controller.Basic is TI : PTI.Task_Info_Access) is begin - pragma Debug (O1 ("Schedule_Task: enter")); + pragma Debug (O1 ("Schedule_Task: enter " & Image (TI.all))); pragma Assert (PTI.State (TI.all) = Unscheduled); @@ -377,14 +384,9 @@ package body PolyORB.ORB_Controller.Basic is O.Idle_Tasks := O.Idle_Tasks + 1; - declare - CV : constant PTCV.Condition_Access := Allocate_CV (O); - - begin - Set_State_Idle (TI.all, CV, O.ORB_Lock); - - Idle_Task_Lists.Append (O.Idle_Task_List, Idle_Task'(CV, TI)); - end; + Set_State_Idle (TI.all, Allocate_CV (O), O.ORB_Lock); + Task_Lists.Prepend (O.Idle_Task_List, TI); + List_Attach (TI.all, Task_Lists.First (O.Idle_Task_List)); pragma Debug (O1 ("Task is now idle")); pragma Debug (O2 (Status (O))); @@ -400,13 +402,13 @@ package body PolyORB.ORB_Controller.Basic is (O : access ORB_Controller_Basic; TI : PTI.Task_Info_Access) is - pragma Warnings (Off); - pragma Unreferenced (TI); - pragma Warnings (On); - + S : constant Task_State := State (TI.all); begin - pragma Debug (O1 ("Unregister_Task: enter")); + pragma Debug (O1 ("Unregister_Task: enter, State = " + & State (TI.all)'Img)); + pragma Debug (O2 (Status (O))); + pragma Assert (S = Terminated); O.Registered_Tasks := O.Registered_Tasks - 1; pragma Debug (O2 (Status (O))); @@ -468,8 +470,7 @@ package body PolyORB.ORB_Controller.Basic is ------------------------- procedure Awake_One_Idle_Task (O : access ORB_Controller_Basic) is - Task_To_Awake : Idle_Task; - + Task_To_Awake : Task_Info_Access; begin if O.Idle_Tasks > 0 then pragma Debug (O1 ("Awake one idle task")); @@ -481,9 +482,10 @@ package body PolyORB.ORB_Controller.Basic is -- Signal one idle task, and puts its CV in Free_CV list - Idle_Task_Lists.Extract_First (O.Idle_Task_List, Task_To_Awake); - Signal (Task_To_Awake.CV); - CV_Lists.Append (O.Free_CV, Task_To_Awake.CV); + Task_Lists.Extract_First (O.Idle_Task_List, Task_To_Awake); + List_Attach (Task_To_Awake.all, Task_Lists.Last (O.Idle_Task_List)); + Signal (Condition (Task_To_Awake.all)); + CV_Lists.Append (O.Free_CV, Condition (Task_To_Awake.all)); else pragma Debug (O1 ("No idle task !")); diff --git a/src/polyorb-orb_controller-basic.ads b/src/polyorb-orb_controller-basic.ads index 63a3b0200..4bc81c727 100644 --- a/src/polyorb-orb_controller-basic.ads +++ b/src/polyorb-orb_controller-basic.ads @@ -99,19 +99,10 @@ private package PTM renames PolyORB.Tasking.Mutexes; package PTCV renames PolyORB.Tasking.Condition_Variables; - -- Under this ORB controller implementation, several tasks may go - -- idle. Each idle task waits on a specific condition variable. - - type Idle_Task is record - CV : PTCV.Condition_Access; - TI : PTI.Task_Info_Access; - end record; - - package Idle_Task_Lists is - new PolyORB.Utils.Chained_Lists (Idle_Task); + package Task_Lists renames PTI.Task_Lists; package CV_Lists is - new PolyORB.Utils.Chained_Lists (PTCV.Condition_Access, PTCV."="); + new PolyORB.Utils.Chained_Lists (PTCV.Condition_Access, PTCV."="); type ORB_Controller_Basic is new ORB_Controller with record @@ -128,7 +119,7 @@ private -- Idle tasks -- ---------------- - Idle_Task_List : Idle_Task_Lists.List; + Idle_Task_List : Task_Lists.List; -- List of idle tasks Free_CV : CV_Lists.List; diff --git a/src/polyorb-orb_controller-half_sync_half_async.adb b/src/polyorb-orb_controller-half_sync_half_async.adb index f569f5929..29786d1ef 100644 --- a/src/polyorb-orb_controller-half_sync_half_async.adb +++ b/src/polyorb-orb_controller-half_sync_half_async.adb @@ -339,6 +339,10 @@ package body PolyORB.ORB_Controller.Half_Sync_Half_Async is null; end case; + + when Idle_Awake => + null; + end case; pragma Debug (O2 (Status (O))); diff --git a/src/polyorb-orb_controller-leader_followers.adb b/src/polyorb-orb_controller-leader_followers.adb index 78dc2ecf3..687961c99 100644 --- a/src/polyorb-orb_controller-leader_followers.adb +++ b/src/polyorb-orb_controller-leader_followers.adb @@ -353,6 +353,10 @@ package body PolyORB.ORB_Controller.Leader_Followers is null; end case; + + when Idle_Awake => + List_Detach (E.Awakened_Task.all, O.Idle_Task_List); + end case; pragma Debug (O2 (Status (O))); @@ -433,14 +437,9 @@ package body PolyORB.ORB_Controller.Leader_Followers is O.Idle_Tasks := O.Idle_Tasks + 1; - declare - CV : constant PTCV.Condition_Access := Allocate_CV (O); - - begin - Set_State_Idle (TI.all, CV, O.ORB_Lock); - - Idle_Task_Lists.Append (O.Idle_Task_List, Idle_Task'(CV, TI)); - end; + Set_State_Idle (TI.all, Allocate_CV (O), O.ORB_Lock); + Idle_Task_Lists.Append (O.Idle_Task_List, TI); + List_Attach (TI.all, Task_Lists.First (O.Idle_Task_List)); pragma Debug (O1 ("Task is now idle")); pragma Debug (O2 (Status (O))); @@ -504,7 +503,7 @@ package body PolyORB.ORB_Controller.Leader_Followers is procedure Awake_One_Idle_Task (O : access ORB_Controller_Leader_Followers) is - Task_To_Awake : Idle_Task; + Task_To_Awake : Task_Info_Access; begin if O.Idle_Tasks > 0 then @@ -518,8 +517,9 @@ package body PolyORB.ORB_Controller.Leader_Followers is -- Signal one idle task, and puts its CV in Free_CV Idle_Task_Lists.Extract_First (O.Idle_Task_List, Task_To_Awake); - Signal (Task_To_Awake.CV); - CV_Lists.Append (O.Free_CV, Task_To_Awake.CV); + List_Attach (Task_To_Awake.all, Task_Lists.Last (O.Idle_Task_List)); + Signal (Condition (Task_To_Awake.all)); + CV_Lists.Append (O.Free_CV, Condition (Task_To_Awake.all)); else pragma Debug (O1 ("No idle task !")); diff --git a/src/polyorb-orb_controller-leader_followers.ads b/src/polyorb-orb_controller-leader_followers.ads index 4ef6cfd69..502656376 100644 --- a/src/polyorb-orb_controller-leader_followers.ads +++ b/src/polyorb-orb_controller-leader_followers.ads @@ -104,16 +104,7 @@ private package PTM renames PolyORB.Tasking.Mutexes; package PTCV renames PolyORB.Tasking.Condition_Variables; - -- Under this ORB controller implementation, several tasks may go - -- idle. Each idle task waits on a specific condition variable. - - type Idle_Task is record - CV : PTCV.Condition_Access; - TI : PTI.Task_Info_Access; - end record; - - package Idle_Task_Lists is - new PolyORB.Utils.Chained_Lists (Idle_Task); + package Idle_Task_Lists renames PTI.Task_Lists; package CV_Lists is new PolyORB.Utils.Chained_Lists (PTCV.Condition_Access, PTCV."="); diff --git a/src/polyorb-orb_controller-no_tasking.adb b/src/polyorb-orb_controller-no_tasking.adb index 3922fcec1..250f401c4 100644 --- a/src/polyorb-orb_controller-no_tasking.adb +++ b/src/polyorb-orb_controller-no_tasking.adb @@ -206,6 +206,10 @@ package body PolyORB.ORB_Controller.No_Tasking is -- it asks for scheduling. null; + + when Idle_Awake => + null; + end case; pragma Debug (O2 (Status (O))); diff --git a/src/polyorb-orb_controller.ads b/src/polyorb-orb_controller.ads index 99dc1f29c..809608912 100644 --- a/src/polyorb-orb_controller.ads +++ b/src/polyorb-orb_controller.ads @@ -92,9 +92,11 @@ package PolyORB.ORB_Controller is Queue_Request_Job, -- Queue a request job - Request_Result_Ready + Request_Result_Ready, -- A Request has been completed + Idle_Awake + -- A task has left Idle state ); -- Event type @@ -116,6 +118,9 @@ package PolyORB.ORB_Controller is when Request_Result_Ready => Requesting_Task : PTI.Task_Info_Access; + when Idle_Awake => + Awakened_Task : PTI.Task_Info_Access; + when others => null; end case; diff --git a/src/polyorb-task_info.adb b/src/polyorb-task_info.adb index bcd5004d9..aff9dd6d2 100644 --- a/src/polyorb-task_info.adb +++ b/src/polyorb-task_info.adb @@ -49,6 +49,33 @@ package body PolyORB.Task_Info is return Tasking.Threads.Image (TI.Id); end Image; + ----------------- + -- List_Attach -- + ----------------- + + procedure List_Attach + (TI : in out Task_Info; + Position : Task_Lists.Iterator) + is + begin + TI.Position := Position; + end List_Attach; + + ----------------- + -- List_Detach -- + ----------------- + + procedure List_Detach + (TI : in out Task_Info; + List : in out Task_Lists.List) + is + begin + if not Task_Lists.Last (TI.Position) then + Task_Lists.Remove (List, TI.Position); + TI.Position := Task_Lists.Last (List); + end if; + end List_Detach; + -------------- -- May_Poll -- -------------- diff --git a/src/polyorb-task_info.ads b/src/polyorb-task_info.ads index d463b2e7f..7e13a867d 100644 --- a/src/polyorb-task_info.ads +++ b/src/polyorb-task_info.ads @@ -44,6 +44,7 @@ with PolyORB.Tasking.Condition_Variables; with PolyORB.Tasking.Mutexes; with PolyORB.Tasking.Threads; with PolyORB.Types; +with PolyORB.Utils.Chained_Lists; package PolyORB.Task_Info is @@ -76,6 +77,8 @@ package PolyORB.Task_Info is -- Task Info holds information on tasks that run ORB.Run type Task_Info_Access is access all Task_Info; + package Task_Lists is new PolyORB.Utils.Chained_Lists + (Task_Info_Access, Doubly_Chained => True); ------------------------------------ -- Task_Info components accessors -- @@ -85,97 +88,88 @@ package PolyORB.Task_Info is (TI : in out Task_Info; Selector : Asynch_Ev.Asynch_Ev_Monitor_Access; Timeout : Duration); - pragma Inline (Set_State_Blocked); -- The task refereed by TI will be blocked on Selector for Timeout seconds procedure Set_State_Idle (TI : in out Task_Info; Condition : PTCV.Condition_Access; Mutex : PTM.Mutex_Access); - pragma Inline (Set_State_Idle); -- The task refereed by TI will go Idle; -- signaling condition variable Condition will awake it. procedure Set_State_Running (TI : in out Task_Info; Job : Jobs.Job_Access); - pragma Inline (Set_State_Running); -- The task refereed by TI is now in Running state, and will execute Job; -- this procedure resets Selector or Condition it was blocked on. procedure Set_State_Unscheduled (TI : in out Task_Info); - pragma Inline (Set_State_Unscheduled); -- The task refereed by TI is now unaffected. procedure Set_State_Terminated (TI : in out Task_Info); - pragma Inline (Set_State_Terminated); -- The task refereed by TI has terminated its job. function State (TI : Task_Info) return Task_State; - pragma Inline (State); -- Return the state of the task referred by TI function Selector (TI : Task_Info) return Asynch_Ev.Asynch_Ev_Monitor_Access; - pragma Inline (Selector); -- Return Selector the task referred by TI is blocked on function Timeout (TI : Task_Info) return Duration; - pragma Inline (Timeout); -- Return Timeout before stopping blocking function Condition (TI : Task_Info) return PTCV.Condition_Access; - pragma Inline (Condition); -- Return Condition Variable the Task referred by TI is blocked on function Mutex (TI : Task_Info) return PTM.Mutex_Access; - pragma Inline (Mutex); -- Return Mutex used by the Task referred by TI when blocking. procedure Set_Id (TI : in out Task_Info); - pragma Inline (Set_Id); -- Task_Info will hold Id of the current task, as provided by -- PolyORB tasking runtime. procedure Set_Polling (TI : in out Task_Info; May_Poll : Boolean); - pragma Inline (Set_Polling); -- Set if TI may poll on event sources, i.e. be in blocked state function May_Poll (TI : Task_Info) return Boolean; - pragma Inline (May_Poll); -- Returns true iff TI may poll, i.e. be in blocked state procedure Set_Exit_Condition (TI : in out Task_Info; Exit_Condition : PolyORB.Types.Boolean_Ptr); - pragma Inline (Set_Exit_Condition); -- Attach Exit_Condition to TI function Exit_Condition (TI : Task_Info) return Boolean; - pragma Inline (Exit_Condition); -- Return the value of TI's exit condition procedure Request_Abort_Polling (TI : in out Task_Info); - pragma Inline (Request_Abort_Polling); -- Request TI to abort polling. Meaningful only if TI is in -- blocked state. function Abort_Polling (TI : Task_Info) return Boolean; - pragma Inline (Abort_Polling); -- Return true if TI must abort polling and leave blocked state. -- Meaningful only if TI is in blocked state. function Image (TI : Task_Info) return String; - pragma Inline (Image); -- For debug purposes function Id (TI : Task_Info) return PolyORB.Tasking.Threads.Thread_Id; - pragma Inline (Id); -- Return thread id associated to TI function Job (TI : Task_Info) return Jobs.Job_Access; - pragma Inline (Job); -- Return job associated to TI + procedure List_Attach + (TI : in out Task_Info; + Position : Task_Lists.Iterator); + -- Record that TI is on a list at the given Position. Clears the + -- attachment information if Position is the end of a list. + + procedure List_Detach + (TI : in out Task_Info; + List : in out Task_Lists.List); + -- Remove TI from the list it was attached to (if any). + private type Task_Info (Kind : Task_Kind) is record @@ -213,6 +207,30 @@ private -- Mutex used by the Task referred by TI when blocking; -- meaningful only when State is Idle. + Position : Task_Lists.Iterator; + -- Iterator designating the position of this task on a + -- list (allowing removal of the task from the list). end record; + pragma Inline (Set_State_Blocked); + pragma Inline (Set_State_Idle); + pragma Inline (Set_State_Running); + pragma Inline (Set_State_Unscheduled); + pragma Inline (Set_State_Terminated); + pragma Inline (State); + pragma Inline (Selector); + pragma Inline (Timeout); + pragma Inline (Condition); + pragma Inline (Mutex); + pragma Inline (Set_Id); + pragma Inline (Set_Polling); + pragma Inline (May_Poll); + pragma Inline (Set_Exit_Condition); + pragma Inline (Exit_Condition); + pragma Inline (Request_Abort_Polling); + pragma Inline (Abort_Polling); + pragma Inline (Image); + pragma Inline (Id); + pragma Inline (Job); + end PolyORB.Task_Info;