------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real time scheduling analysis tool. -- This program provides services to automatically check performances -- of real time architectures. -- -- Copyright (C) 2002-2010, by Frank Singhoff, Alain Plantec, Jerome Legrand -- -- The Cheddar project was started in 2002 by -- the LISyC Team, University of Western Britanny. -- -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- ----------------------------------------------------------------------------- -- Last update : -- $Rev: 209 $ -- $Date: 2008-06-29 14:47:31 +0200 (dim., 29 juin 2008) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Scheduler; use Scheduler; with scheduling_analysis; use scheduling_analysis; use scheduling_analysis.Double_Tasks_Parameters_Package; with Scheduler.Fixed_Priority; use Scheduler.Fixed_Priority; with Scheduler.Fixed_Priority.Hpf; use Scheduler.Fixed_Priority.Hpf; with Text_IO; use Text_IO; with Translate; use Translate; with unbounded_strings; use unbounded_strings; with Scheduler; use Scheduler; with scheduling_analysis; use scheduling_analysis; use scheduling_analysis.Double_Tasks_Parameters_Package; package body Scheduler.Hierarchical.sporadic_aperiodic_server is function Build_Tcb (My_Scheduler : in Fixed_Priority_Scheduler; A_Task : Generic_Task_Ptr) return Tcb_Ptr is A_Tcb : Fixed_Priority_Tcb_Ptr; begin A_Tcb := new Fixed_Priority_Tcb; Initialize (Tcb (A_Tcb.all), A_Task); Initialize (A_Tcb.all); return Tcb_Ptr (A_Tcb); end Build_Tcb; function Build_Resource (My_Scheduler : in Hierarchical_sporadic_aperiodic_server_Scheduler; A_Resource : Generic_Resource_Ptr) return Shared_Resource_Ptr is begin return Build_Resource(Fixed_priority_Scheduler(My_Scheduler), A_Resource); end Build_Resource; function Build_Tcb (My_Scheduler : in Hierarchical_sporadic_aperiodic_server_Scheduler; A_Task : Generic_Task_Ptr) return Tcb_Ptr is A_Tcb : Hpf_Tcb_Ptr; begin A_Tcb := new Hpf_Tcb; Initialize (Tcb (A_Tcb.all), A_Task); Initialize (Fixed_Priority_Tcb (A_Tcb.all)); Initialize (A_Tcb.all); return Tcb_Ptr (A_Tcb); end Build_Tcb; procedure Do_Election (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Msg : in out Unbounded_String; Current_Time : in Natural; Processor_Name : in Unbounded_String; Address_Space_Name : in Unbounded_String; My_Dependencies : in Tasks_Dependencies_Ptr; With_Offsets : in Boolean; With_Precedencies : in Boolean; With_Resources : in Boolean; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table; Elected : in out Tasks_Range; No_Task : in out Boolean) is Highiest_Priority : Natural := Natural'First; I : Tasks_Range := 0; begin -- For each task, call "check_resources" to -- take care of priority modification (PCP and PIP) -- loop if (Si.Tcbs (I).Tsk.Cpu_Name = Processor_Name) and ((Address_Space_Name = To_Unbounded_String ("")) or (Address_Space_Name = Si.Tcbs (I).Tsk.Address_Space_Name)) then if (Si.Tcbs (I).Wake_Up_Time <= Current_Time) and (Si.Tcbs (I).Rest_Of_Capacity /= 0) then if (With_Offsets = False) or Check_Offset (Si.Tcbs (I), Current_Time) then if (With_Precedencies = False) or Check_Precedencies (Si, My_Dependencies, Current_Time, Si.Tcbs (I)) then if With_Resources then Check_Resource (My_Scheduler, Si, Result, Current_Time, Si.Tcbs (I), Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Is_Ready, Event_To_Generate); end if; end if; end if; end if; end if; I := I + 1; exit when Si.Tcbs (I) = null; end loop; -- We can compute scheduling since priorities are ok -- I := 0; loop if (Si.Tcbs (I).Tsk.cpu_name = Processor_Name) then if (Si.Tcbs (I).assigned_core_unit = empty_string or Si.Tcbs (I).assigned_core_unit = My_Scheduler.corresponding_core_unit) if (Si.Tcbs (I).Wake_Up_Time <= Current_Time) and (Natural ( Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Current_Priority) > Highiest_Priority) and (Si.Tcbs (I).Rest_Of_Capacity /= 0) then if (With_Offsets = False) or Check_Offset (Si.Tcbs (I), Current_Time) then if (With_Precedencies = False) or Check_Precedencies (Si, My_Dependencies, Current_Time, Si.Tcbs (I)) then if (With_Resources = False) or Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Is_Ready then Highiest_Priority := Natural ( Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)). Current_Priority); Elected := I; end if; end if; end if; end if; end if; end if; I := I + 1; exit when Si.Tcbs (I) = null; end loop; if Highiest_Priority = Natural'First then No_Task := True; else No_Task := False; end if; end Do_Election; procedure Set_Priority_According_To_Dm (My_Scheduler : in Fixed_Priority_Scheduler; My_Tasks : in out Tasks_Set; Processor_Name : in Unbounded_String := Empty_String) is Iterator1 : Tasks_Iterator; Task1 : Generic_Task_Ptr; Iterator2 : Tasks_Iterator; Task2 : Generic_Task_Ptr; Current_Prio : Priority_Range := 1; Tmp : Tasks_Set; begin if Processor_Name = Empty_String then Duplicate (My_Tasks, Tmp); else Current_Processor_Name := Processor_Name; Select_And_Copy (My_Tasks, Tmp, Select_Cpu'Access); end if; Sort (Tmp, Decreasing_Deadline'Access); -- Assign priorities -- Reset_Iterator (Tmp, Iterator1); loop Current_Element (Tmp, Task1, Iterator1); if (Task1.Cpu_Name = Processor_Name) or (Processor_Name = Empty_String) then Task1.Priority := Current_Prio; Current_Prio := Current_Prio + 1; end if; exit when Is_Last_Element (Tmp, Iterator1); Next_Element (Tmp, Iterator1); end loop; -- Copy resulting task objects in My_Tasks -- Reset_Iterator (Tmp, Iterator1); loop Current_Element (Tmp, Task1, Iterator1); Reset_Iterator (My_Tasks, Iterator2); loop Current_Element (My_Tasks, Task2, Iterator2); if (Task2.Name = Task1.Name) then Task2.Priority := Task1.Priority; end if; exit when Task2.Name = Task1.Name; exit when Is_Last_Element (My_Tasks, Iterator2); Next_Element (My_Tasks, Iterator2); end loop; exit when Is_Last_Element (Tmp, Iterator1); Next_Element (Tmp, Iterator1); end loop; Free (Tmp); end Set_Priority_According_To_Dm; procedure Set_Priority_According_To_Rm (My_Scheduler : in Fixed_Priority_Scheduler; My_Tasks : in out Tasks_Set; Processor_Name : in Unbounded_String := Empty_String) is Iterator1 : Tasks_Iterator; Task1 : Generic_Task_Ptr; Iterator2 : Tasks_Iterator; Task2 : Generic_Task_Ptr; Current_Prio : Priority_Range := 1; Tmp : Tasks_Set; begin if Processor_Name = Empty_String then Duplicate (My_Tasks, Tmp); else Current_Processor_Name := Processor_Name; Select_And_Copy (My_Tasks, Tmp, Select_Cpu'Access); end if; Periodic_Control (Tmp, Processor_Name); Sort (Tmp, Decreasing_Period'Access); -- Assign priorities -- Reset_Iterator (Tmp, Iterator1); loop Current_Element (Tmp, Task1, Iterator1); if (Task1.Cpu_Name = Processor_Name) or (Processor_Name = Empty_String) then Task1.Priority := Current_Prio; Current_Prio := Current_Prio + 1; end if; exit when Is_Last_Element (Tmp, Iterator1); Next_Element (Tmp, Iterator1); end loop; -- Copy resulting task objects in My_Tasks -- Reset_Iterator (Tmp, Iterator1); loop Current_Element (Tmp, Task1, Iterator1); Reset_Iterator (My_Tasks, Iterator2); loop Current_Element (My_Tasks, Task2, Iterator2); if (Task2.Name = Task1.Name) then Task2.Priority := Task1.Priority; end if; exit when Task2.Name = Task1.Name; exit when Is_Last_Element (My_Tasks, Iterator2); Next_Element (My_Tasks, Iterator2); end loop; exit when Is_Last_Element (Tmp, Iterator1); Next_Element (Tmp, Iterator1); end loop; Free (Tmp); end Set_Priority_According_To_Rm; procedure Compute_Ceiling_Of_Resources (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Processor_Name : in Unbounded_String; Address_space_Name : in Unbounded_String; My_Tasks : in out Tasks_Set; My_Resources : in out Resources_Set) is begin -- Private scheduler data -- My_Scheduler.Used_Resource := False; -- Set priority ceiling of resources (only for PCP and IPCP resources) -- for K in 0 .. Si.Number_Of_Resources - 1 loop if (Si.Shared_Resources (K).Shared.protocol = Priority_Ceiling_Protocol) or (Si.Shared_Resources (K).Shared.protocol = Immediate_Priority_Ceiling_Protocol) then if Si.Shared_Resources (K).Shared.cpu_name = Processor_Name then Fixed_Priority_Resource_Ptr (Si.Shared_Resources (K)). Priority_Ceiling := Priority_Range'First; for I in 0 .. Si.Shared_Resources (K).Shared.task_tab.Nb_Entries - 1 loop -- Looking for the task -- for J in 0 .. Si.Number_Of_Tasks - 1 loop if Si.Tcbs (J).Tsk.Cpu_Name = Processor_Name and ((Address_space_Name = To_Unbounded_String ("")) or (Address_space_Name = Si.Tcbs (J).Tsk.Address_Space_Name)) then if Si.Shared_Resources (K).Shared.task_tab.Entries (I). Item = Si.Tcbs (J).Tsk.Name then Fixed_Priority_Resource_Ptr (Si.Shared_Resources (K) ).Priority_Ceiling := Priority_Range'Max (Fixed_Priority_Tcb_Ptr (Si.Tcbs (J)). Current_Priority, Fixed_Priority_Resource_Ptr ( Si.Shared_Resources (K)).Priority_Ceiling); end if; end if; end loop; end loop; end if; end if; end loop; end Compute_Ceiling_Of_Resources; procedure Specific_Scheduler_Initialization (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Processor_Name : in Unbounded_String; address_space_name : in Unbounded_String; My_Tasks : in out Tasks_Set; my_schedulers : in Scheduler_table; My_Resources : in out Resources_Set; My_Buffers : in out Buffers_Set; My_Messages : in Messages_Set; Msg : in out Unbounded_String) is begin -- Set priority according to the scheduler -- if (My_Scheduler.parameters.Name = Deadline_Monotonic_Protocol) then Set_Priority_According_To_Dm (My_Scheduler, My_Tasks); else if (My_Scheduler.parameters.Name = Rate_Monotonic_Protocol) then Set_Priority_According_To_Rm (My_Scheduler, My_Tasks); end if; end if; for I in 0 .. Si.Number_Of_Tasks - 1 loop if (Si.Tcbs (I).Tsk.Cpu_Name = Processor_Name) and ((address_space_name = To_Unbounded_String ("")) or (address_space_name = Si.Tcbs (I).Tsk.Address_Space_Name)) then Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Current_Priority := Si.Tcbs (I).Tsk.Priority; end if; end loop; -- Set priority ceiling of resources (only to PCP resource -- Compute_Ceiling_Of_Resources (My_Scheduler, Si, Processor_Name, address_space_name, My_Tasks, My_Resources); end Specific_Scheduler_Initialization; procedure Release_Resource (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is Current_Capacity : Natural := 0; A_Item : Time_Unit_Event_Ptr; B : Boolean; begin if (Si.Number_Of_Resources > 0) then Current_Capacity := A_Tcb.Tsk.Capacity - A_Tcb.Rest_Of_Capacity + 1; for Index1 in 0 .. Si.Number_Of_Resources - 1 loop -- For each resource, check if the task hold resources -- and then release them -- for Index2 in 0 .. Si.Shared_Resources (Index1).Shared.task_tab.Nb_Entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.task_tab.Entries ( Index2).Data.Task_End) and (Si.Shared_Resources (Index1).Shared.task_tab.Entries ( Index2).Item = A_Tcb.Tsk.Name) then Si.Shared_Resources (Index1).Shared.state := Si.Shared_Resources (Index1).Shared.state + 1; for I in 0 .. Si.Shared_Resources (Index1).Nb_Allocated - 1 loop if Si.Shared_Resources (Index1).Allocated_By (I) = A_Tcb.Tsk.Name then Si.Shared_Resources (Index1).Allocated_By (I) := Si.Shared_Resources (Index1).Allocated_By ( Si.Shared_Resources (Index1).Nb_Allocated - 1); Si.Shared_Resources (Index1).Nb_Allocated := Si.Shared_Resources (Index1).Nb_Allocated - 1; if Event_To_Generate (Release_Resource) then A_Item := new Time_Unit_Event (Release_Resource); A_Item.Release_Resource := Si.Shared_Resources (Index1).Shared; A_Item.Release_Task := A_Tcb.Tsk; Add (Result.all, A_Item, Current_Time); end if; exit; end if; end loop; -- If PIP or PCP is used, releasing a shared resource -- should restore initial priority level of the -- task -- if (Si.Shared_Resources (Index1).Shared.protocol = Priority_Inheritance_Protocol) or (Si.Shared_Resources (Index1).Shared.protocol = Priority_Ceiling_Protocol) then Change_Current_Priority (My_Scheduler, Fixed_Priority_Tcb_Ptr (A_Tcb), A_Tcb.Tsk.Priority); end if; -- If IPCP is used, once all IPCP resources have been -- released by the task, initial priority level of the -- task should be restored -- if (Si.Shared_Resources (Index1).Shared.protocol = Immediate_Priority_Ceiling_Protocol) then B := True; for I1 in 0 .. Si.Number_Of_Resources - 1 loop for I2 in 0 .. Si.Shared_Resources (I1).Shared.task_tab. Nb_Entries - 1 loop if ( Si.Shared_Resources (I1).Shared.task_tab. Entries (I2).Item = A_Tcb.Tsk.Name) and (Current_Capacity < Si.Shared_Resources (I1).Shared.task_tab. Entries (Index2).Data.Task_End) and (Current_Capacity >= Si.Shared_Resources (I1).Shared.task_tab. Entries (Index2).Data.Task_Begin) and (Si.Shared_Resources (I1).Shared.protocol = Immediate_Priority_Ceiling_Protocol) then B := False; end if; end loop; end loop; if B and (A_Tcb.Tsk.Priority /= Fixed_Priority_Tcb_Ptr (A_Tcb).Current_Priority) then Change_Current_Priority (My_Scheduler, Fixed_Priority_Tcb_Ptr (A_Tcb), A_Tcb.Tsk.Priority); end if; end if; end if; end loop; end loop; end if; end Release_Resource; procedure Allocate_Resource (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is Current_Capacity : Natural := 0; A_Item : Time_Unit_Event_Ptr; begin if (Si.Number_Of_Resources > 0) then Current_Capacity := A_Tcb.Tsk.Capacity - A_Tcb.Rest_Of_Capacity + 1; for Index1 in 0 .. Si.Number_Of_Resources - 1 loop -- For each resource, check if the task request the resource -- and if the resource is free -- otherwise, block the task -- for Index2 in 0 .. Si.Shared_Resources (Index1).Shared.task_tab.Nb_Entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.task_tab.Entries ( Index2).Data.Task_Begin) and (Si.Shared_Resources (Index1).Shared.task_tab.Entries ( Index2).Item = A_Tcb.Tsk.Name) then Si.Shared_Resources (Index1).Shared.state := Si.Shared_Resources (Index1).Shared.state - 1; Si.Shared_Resources (Index1).Allocated_By ( Si.Shared_Resources (Index1).Nb_Allocated) := A_Tcb.Tsk.Name; Si.Shared_Resources (Index1).Nb_Allocated := Si.Shared_Resources (Index1).Nb_Allocated + 1; if Event_To_Generate (Allocate_Resource) then A_Item := new Time_Unit_Event (Allocate_Resource); A_Item.Allocate_Resource := Si.Shared_Resources (Index1).Shared; A_Item.Allocate_Task := A_Tcb.Tsk; Add (Result.all, A_Item, Current_Time); end if; end if; end loop; end loop; end if; end Allocate_Resource; procedure Check_Resource (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : in Tcb_Ptr; Is_Ready : out Boolean; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is Current_Capacity : Natural := 0; A_Item : Time_Unit_Event_Ptr; begin Is_Ready := True; if (Si.Number_Of_Resources > 0) then Current_Capacity := A_Tcb.Tsk.Capacity - A_Tcb.Rest_Of_Capacity + 1; for Index1 in 0 .. Si.Number_Of_Resources - 1 loop -- For each resource, check if the task requests the resource -- and if the resource is free -- for Index2 in 0 .. Si.Shared_Resources (Index1).Shared.task_tab.Nb_Entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.task_tab.Entries ( Index2).Data.Task_Begin) and (Si.Shared_Resources (Index1).Shared.task_tab.Entries ( Index2).Item = A_Tcb.Tsk.Name) then -- PCP blocking : current ceiling priority should be less or --equal than -- the priority of the required resource -- if (Si.Shared_Resources (Index1).Shared.protocol = Priority_Ceiling_Protocol) then -- Scan already allocated resources to check if the --requiring task -- has a highier priority than the resource -- ceiling value : block the task in the other case -- for Index3 in 0 .. Si.Number_Of_Resources - 1 loop if Si.Shared_Resources (Index3).Nb_Allocated > 0 then for Index4 in 0 .. Si.Shared_Resources (Index3).Nb_Allocated - 1 loop if (Si.Shared_Resources (Index3).Allocated_By ( Index4) /= A_Tcb.Tsk.Name) and (Fixed_Priority_Resource_Ptr ( Si.Shared_Resources (Index3)). Priority_Ceiling >= Fixed_Priority_Tcb_Ptr (A_Tcb). Current_Priority) then Is_Ready := False; end if; end loop; end if; end loop; end if; if (Si.Shared_Resources (Index1).Shared.state = 0) then Is_Ready := False; -- Find if we must change a priority level of a task -- that takes the resource (PIP or PCP protocols) -- if (Si.Shared_Resources (Index1).Shared.protocol = Priority_Inheritance_Protocol) or (Si.Shared_Resources (Index1).Shared.protocol = Priority_Ceiling_Protocol) then for I in 0 .. Si.Shared_Resources (Index1).Nb_Allocated - 1 loop for J in 0 .. Si.Number_Of_Tasks - 1 loop if Si.Shared_Resources (Index1).Allocated_By (I) = Si.Tcbs (J).Tsk.Name then Change_Current_Priority (My_Scheduler, Fixed_Priority_Tcb_Ptr (Si.Tcbs (J)), Priority_Range'Max (Fixed_Priority_Tcb_Ptr (A_Tcb). Current_Priority, Fixed_Priority_Tcb_Ptr (Si.Tcbs (J)). Current_Priority)); end if; end loop; end loop; end if; end if; if Is_Ready = False then if Event_To_Generate (Wait_For_Resource) then A_Item := new Time_Unit_Event (Wait_For_Resource); A_Item.Wait_for_Resource := Si.Shared_Resources (Index1).Shared; A_Item.Wait_for_Task := A_Tcb.Tsk; Add (Result.all, A_Item, Current_Time); end if; end if; -- when allocating an IPCP resource, task priority should be -- raised to resource priority ceiling -- if Is_Ready and (Si.Shared_Resources (Index1).Shared.protocol = Immediate_Priority_Ceiling_Protocol) and (Fixed_Priority_Resource_Ptr (Si.Shared_Resources (Index1) ).Priority_Ceiling > Fixed_Priority_Tcb_Ptr (A_Tcb).Current_Priority) then Change_Current_Priority (My_Scheduler, Fixed_Priority_Tcb_Ptr (A_Tcb), Fixed_Priority_Resource_Ptr (Si.Shared_Resources ( Index1)).Priority_Ceiling); end if; end if; end loop; end loop; end if; end Check_Resource; function Build_Resource (My_Scheduler : in Fixed_Priority_Scheduler; A_Resource : Generic_Resource_Ptr) return Shared_Resource_Ptr is New_A_Resource : Fixed_Priority_Resource_Ptr; begin New_A_Resource := new Fixed_Priority_Resource; New_A_Resource.Shared := A_Resource; -- Set priority ceiling of the resource -- New_A_Resource.Priority_Ceiling := Low_Priority; return Shared_Resource_Ptr (New_A_Resource); end Build_Resource; procedure Change_Current_Priority (My_Scheduler : in out Fixed_Priority_Scheduler'Class; A_Tcb : in Fixed_Priority_Tcb_Ptr; New_Priority : Priority_Range) is begin Dispatched_Change_Current_Priority (My_Scheduler, A_Tcb, New_Priority); end Change_Current_Priority; procedure Dispatched_Change_Current_Priority (My_Scheduler : in out Fixed_Priority_Scheduler; A_Tcb : in Fixed_Priority_Tcb_Ptr; New_Priority : Priority_Range) is begin A_Tcb.Current_Priority := New_Priority; end Dispatched_Change_Current_Priority; function Compute_Pcp_Blocking_Time (My_Tasks : in Tasks_Set; My_Resources : in Resources_Set; Task_Name : in Unbounded_String) return Natural is Blocking_Time : Natural := 0; My_Resource_Iterator : Resources_Iterator; A_Resource : Generic_Resource_Ptr; A_Task1_Ptr : Generic_Task_Ptr; A_Task2_Ptr : Generic_Task_Ptr; begin Reset_Iterator (My_Resources, My_Resource_Iterator); loop Current_Element (My_Resources, A_Resource, My_Resource_Iterator); if (A_Resource.protocol /= Priority_Ceiling_Protocol) and (A_Resource.protocol /= Immediate_Priority_Ceiling_Protocol) then raise Other_Resources_Protocol_Found; end if; for I in 0 .. A_Resource.task_tab.Nb_Entries - 1 loop -- We are on a resource used by Task_Name -- Let find now the largest private section -- if (A_Resource.task_tab.Entries (I).Item = Task_Name) then for J in 0 .. A_Resource.task_tab.Nb_Entries - 1 loop if (A_Resource.task_tab.Entries (J).Item /= Task_Name) then -- Check that the task is a lower priority task -- A_Task1_Ptr := Search_Task (My_Tasks, Task_Name); A_Task2_Ptr := Search_Task (My_Tasks, A_Resource.task_tab.Entries (J).Item); if A_Task2_Ptr.Priority < A_Task1_Ptr.Priority then Blocking_Time := Natural'Max (Blocking_Time, A_Resource.task_tab.Entries (J).Data.Task_End - A_Resource.task_tab.Entries (J).Data.Task_Begin + 1); end if; end if; end loop; end if; end loop; exit when Is_Last_Element (My_Resources, My_Resource_Iterator); Next_Element (My_Resources, My_Resource_Iterator); end loop; return Blocking_Time; end Compute_Pcp_Blocking_Time; function Compute_Pip_Blocking_Time (My_Tasks : in Tasks_Set; My_Resources : in Resources_Set; Task_Name : in Unbounded_String) return Natural is Blocking_Time : Natural := 0; My_Resource_Iterator : Resources_Iterator; A_Resource : Generic_Resource_Ptr; My_task_Iterator : Tasks_Iterator; A_Task1 : constant Generic_Task_Ptr := Search_Task (My_Tasks, Task_Name); A_Task2 : Generic_Task_Ptr; begin -- We look for all task which has a lowest priority -- Then, we add all critical section of these task -- Reset_Iterator (My_Tasks, My_task_Iterator); loop Current_Element (My_Tasks, A_Task2, My_task_Iterator); if (A_Task2.Priority <= A_Task1.Priority) and (A_Task2.Name /= A_Task1.Name) then -- We found a lowest priority task : now, find its critical -- sections ! -- Reset_Iterator (My_Resources, My_Resource_Iterator); loop Current_Element (My_Resources, A_Resource, My_Resource_Iterator); if A_Resource.protocol /= Priority_Inheritance_Protocol then raise Other_Resources_Protocol_Found; end if; for I in 0 .. A_Resource.task_tab.Nb_Entries - 1 loop -- We found a given critical section : increase blocking --time ! -- if (A_Resource.task_tab.Entries (I).Item = A_Task2.Name) then Blocking_Time := Blocking_Time + A_Resource.task_tab.Entries (I).Data. Task_End - A_Resource.task_tab.Entries (I).Data. Task_Begin + 1; end if; end loop; exit when Is_Last_Element (My_Resources, My_Resource_Iterator); Next_Element (My_Resources, My_Resource_Iterator); end loop; end if; exit when Is_Last_Element (My_Tasks, My_task_Iterator); Next_Element (My_Tasks, My_task_Iterator); end loop; return Blocking_Time; end Compute_Pip_Blocking_Time; function Compute_Bound_On_Task_Blocking_Time (My_Scheduler : in Fixed_Priority_Scheduler; My_Tasks : in Tasks_Set; My_Resources : in Resources_Set; A_Task : in Unbounded_String) return Natural is Bound_On_Blocking_Time : Natural := 0; Iterator1 : Resources_Iterator; Resource1 : Generic_Resource_Ptr; begin -- First check that each resource used by the task have the same protocol -- Same_Protocol_Control (My_Resources, A_Task); -- Dispatch blocking computation according to the protocol of resources -- Reset_Iterator (My_Resources, Iterator1); loop Current_Element (My_Resources, Resource1, Iterator1); -- Looking for task user in the task_list index_table -- for I in 0 .. Resource1.task_tab.Nb_Entries - 1 loop case Resource1.protocol is when Priority_Ceiling_Protocol | Immediate_Priority_Ceiling_Protocol => Bound_On_Blocking_Time := Compute_Pcp_Blocking_Time (My_Tasks, My_Resources, A_Task); when Priority_Inheritance_Protocol => Bound_On_Blocking_Time := Compute_Pip_Blocking_Time (My_Tasks, My_Resources, A_Task); when others => raise Invalid_Protocol; end case; return Bound_On_Blocking_Time; end loop; exit when Is_Last_Element (My_Resources, Iterator1); Next_Element (My_Resources, Iterator1); end loop; return Bound_On_Blocking_Time; end Compute_Bound_On_Task_Blocking_Time; procedure Compute_Blocking_Time (My_Scheduler : in Fixed_Priority_Scheduler; My_Tasks : in Tasks_Set; My_Resources : in Resources_Set; Processor_Name : in Unbounded_String; Msg : in out Unbounded_String; Blocking_Time : out Blocking_Time_Table) is My_Task_Iterator1 : Tasks_Iterator; Tmp : Tasks_Set; A_Task1 : Generic_Task_Ptr; begin Current_Processor_Name := Processor_Name; Select_And_Copy (My_Tasks, Tmp, Select_Cpu'Access); -- Set priority according to the scheduler -- if (My_Scheduler.parameters.Name = Deadline_Monotonic_Protocol) then Set_Priority_According_To_Dm (My_Scheduler, Tmp); else if (My_Scheduler.parameters.Name = Rate_Monotonic_Protocol) then Set_Priority_According_To_Rm (My_Scheduler, Tmp); end if; end if; Initialize (Blocking_Time); -- Compute blocking time for each task -- Reset_Iterator (Tmp, My_Task_Iterator1); loop Current_Element (Tmp, A_Task1, My_Task_Iterator1); if A_Task1.Cpu_Name = Processor_Name then begin Blocking_Time.Entries (Blocking_Time.Nb_Entries).Data := Double(Compute_Bound_On_Task_Blocking_Time (My_Scheduler, Tmp, My_Resources, A_Task1.Name) ); Blocking_Time.Entries (Blocking_Time.Nb_Entries).Item := A_Task1; Blocking_Time.Nb_Entries := Blocking_Time.Nb_Entries + 1; exception when Can_Not_Used_Different_Protocol => Msg := Msg & Unbounded_Lf & To_Unbounded_String (" ") & A_Task1.Name & " => " & Lb_Compute_Blocking_Error1 (Current_Language); when Invalid_Protocol => Msg := Msg & Unbounded_Lf & To_Unbounded_String (" ") & A_Task1.Name & " => " & Lb_Compute_Blocking_Error3 (Current_Language); end; end if; exit when Is_Last_Element (Tmp, My_Task_Iterator1); Next_Element (Tmp, My_Task_Iterator1); end loop; if Msg /= Empty_String then Msg := Msg & Unbounded_Lf; end if; end Compute_Blocking_Time; function Produce_Running_Task_Event (My_Scheduler : in Fixed_Priority_Scheduler; A_Task : in Tcb_Ptr) return Time_Unit_Event_Ptr is A_Item : Time_Unit_Event_Ptr; begin A_Item := new Time_Unit_Event (Running_Task); A_Item.Running_Task := A_Task.Tsk; A_Item.Running_Core := My_Scheduler.corresponding_core_unit; A_Item.Current_Priority := Fixed_Priority_Tcb_Ptr (A_Task).Current_Priority; return A_Item; end Produce_Running_Task_Event; function Export_Xml_Event_Running_Task (My_Scheduler : in Fixed_Priority_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := Empty_String; begin Result := " " & An_Event.Running_Task.Name & " " & Priority_Range'Image (An_Event.Current_Priority) & " " & An_event.Running_Core & " " ; return Result; end Export_Xml_Event_Running_Task; end Scheduler.Fixed_Priority; procedure Initialize (A_Scheduler : in out Hierarchical_sporadic_aperiodic_server_Scheduler) is begin Reset (A_Scheduler); A_Scheduler.parameters.name := Hierarchical_sporadic_aperiodic_server_Protocol; A_Scheduler.address_space_index := 0; end Initialize; function Copy (A_Scheduler : in Hierarchical_sporadic_aperiodic_server_Scheduler) return Generic_Scheduler_Ptr is Ptr : Hierarchical_sporadic_aperiodic_server_Scheduler_Ptr; begin Ptr := new Hierarchical_sporadic_aperiodic_server_Scheduler; Ptr.parameters := A_Scheduler.parameters; Ptr.Previously_Elected := A_Scheduler.Previously_Elected; return Generic_Scheduler_Ptr (Ptr); end Copy; procedure Check_Before_Scheduling (My_Scheduler : in Hierarchical_sporadic_aperiodic_server_Scheduler; My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String) is begin null; end Check_Before_Scheduling; procedure Specific_Scheduler_Initialization (My_Scheduler : in out Hierarchical_sporadic_aperiodic_server_Scheduler; Si : in out Scheduling_Information; Processor_Name : in Unbounded_String; address_space_name : in Unbounded_String; My_Tasks : in out Tasks_Set; my_schedulers : in Scheduler_table; My_Resources : in out Resources_Set; My_Buffers : in out Buffers_Set; My_Messages : in Messages_Set; Msg : in out Unbounded_String) is begin -- Save local address schedulers -- My_Scheduler.Local_Scheduler := my_schedulers; -- Do local scheduler initializations -- for i in scheduler_range loop if (My_Scheduler.Local_Scheduler (i) /= null) then Specific_Scheduler_Initialization (My_Scheduler.Local_Scheduler (i).scheduler.all, Si, Processor_Name, My_Scheduler.Local_Scheduler (i).address_space_name, My_Tasks, my_schedulers, My_Resources, My_Buffers, My_Messages, Msg); end if; end loop; end Specific_Scheduler_Initialization; procedure Do_Election (My_Scheduler : in out Hierarchical_sporadic_aperiodic_server_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Msg : in out Unbounded_String; Current_Time : in Natural; Processor_Name : in Unbounded_String; Address_Space_Name : in Unbounded_String; My_Dependencies : in Tasks_Dependencies_Ptr; With_Offsets : in Boolean; With_Precedencies : in Boolean; With_Resources : in Boolean; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table; Elected : in out Tasks_Range; No_Task : in out Boolean) is begin -- Call the scheduler associated to the current address space -- No method dispatch => some scheduler are not allowed -- Do_Election (Hpf_Scheduler ( My_Scheduler.Local_Scheduler (My_Scheduler.address_space_index). scheduler.all), Si, Result, Msg, Current_Time, Processor_Name, My_Scheduler.Local_Scheduler (My_Scheduler.address_space_index). address_space_name, My_Dependencies, With_Offsets, With_Precedencies, With_Resources, Event_To_Generate, Elected, No_Task); -- Check if we must switch the activated/schedulable address space -- My_Scheduler.Local_Scheduler (My_Scheduler.address_space_index).used_cpu := My_Scheduler.Local_Scheduler (My_Scheduler.address_space_index). used_cpu + 1; if My_Scheduler.Local_Scheduler (My_Scheduler.address_space_index). used_cpu >= Get_Quantum ( My_Scheduler.Local_Scheduler (My_Scheduler.address_space_index). scheduler.all) then -- Address space switching -- My_Scheduler.Local_Scheduler (My_Scheduler.address_space_index). used_cpu := 0; My_Scheduler.address_space_index := My_Scheduler.address_space_index + 1; if My_Scheduler.Local_Scheduler (My_Scheduler.address_space_index) = null then My_Scheduler.address_space_index := 0; end if; -- Reset task wake up time at address space wake up time -- for I in 0 .. Si.Number_Of_Tasks - 1 loop if (Si.Tcbs (I).Tsk.Address_Space_Name = My_Scheduler.Local_Scheduler (My_Scheduler.address_space_index) .address_space_name) then Si.Tcbs (I).Wake_Up_Time := Current_Time + 1; end if; end loop; end if; -- Restart the aperiodic server capacity and release time -- if my_scheduler.next_server_wake_time=current_time then my_scheduler.next_server_wake_time:=current_time+my_scheduler.parameters.period; my_scheduler.current_server_capacity:=my_scheduler.parameters.capacity; end if; end Do_Election; end Scheduler.Hierarchical.sporadic_aperiodic_server;