------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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: 548 $ -- $Date: 2012-10-12 01:48:51 +0200 (Fri, 12 Oct 2012) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ 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.Fixed_Priority 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; procedure Initialize (A_Tcb : in out Fixed_Priority_Tcb) is begin A_Tcb.Current_Priority := A_Tcb.Tsk.priority; end Initialize; 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) and ((Address_Space_Name = To_Unbounded_String ("")) or (Address_Space_Name = Si.Tcbs (I).Tsk.address_space_name)) then if (Si.Tcbs (I).assigned_core_unit = empty_string or Si.Tcbs (I).assigned_core_unit = My_Scheduler.corresponding_core_unit) then 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 Bound_On_Processor_Utilization (My_Scheduler : in Fixed_Priority_Scheduler; My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String; Result : in out Double; Msg : in out Unbounded_String) is Nb : constant Double := Double (Get_Number_Of_Task_From_Processor (My_Tasks, Processor_Name)); begin if not Is_Harmonic (My_Tasks, Processor_Name) then Msg := To_Unbounded_String ("[1], page 16, ") & Lb_Theorem (Current_Language) & To_Unbounded_String ("8"); Result := Nb * (Pow (2.0, (1.0 / Nb)) - 1.0); else Msg := To_Unbounded_String ("[19], page 13"); Result := 1.0; end if; end Bound_On_Processor_Utilization; function Compute_Wiq_non_preemptive (My_Tasks : in Tasks_Set; --all the task Current_Task : in Generic_Task_Ptr; --the task examine q : in Integer) return Double is Iterator2 : Tasks_Iterator; Iterator3 : Tasks_Iterator; Taskk, Taskj : Generic_Task_Ptr; Ck, Ck_tmp, Wiq_k, Wiq_k1 : Double; begin --initialization -- Wiq_k := -0.1; Wiq_k1 := 1.0; Ck := 0.0; Ck_tmp := 0.0; -- approximations for Wiq -- exit loop when approximations converge -- while Wiq_k1 /= Wiq_k loop reset_iterator (My_Tasks, Iterator2); Wiq_k := Wiq_k1; Wiq_k1 := Double (q * Current_Task.capacity); -- Iterate on all tasks -- loop current_element (My_Tasks, Taskj, Iterator2); -- If Taskj is in hp(Taski) -- if (Taskj.priority > Current_Task.priority) then Wiq_k1 := Wiq_k1 + (Double'Floor (Wiq_k / Double (Periodic_Task_Ptr (Taskj).period)) + 1.0) * Double (Taskj.capacity); end if; -- exit loop when there is no more task -- exit when is_last_element (My_Tasks, Iterator2); next_element (My_Tasks, Iterator2); end loop; --compute the max{Ck-1} -- loop current_element (My_Tasks, Taskk, Iterator3); if (Taskk.priority < Current_Task.priority) then Ck_tmp := Double (Taskk.capacity) - 1.0; if (Ck_tmp > Ck) then Ck := Ck_tmp; end if; end if; exit when is_last_element (My_Tasks, Iterator3); next_element (My_Tasks, Iterator3); end loop; Wiq_k1 := Wiq_k1 + Ck; end loop; return Wiq_k1; end Compute_Wiq_non_preemptive; -- compute the value of level-i busy period -- function compute_L (My_Tasks : in Tasks_Set; Current_Task : in Generic_Task_Ptr) return Double is Iterator2 : Tasks_Iterator; Taskj2 : Generic_Task_Ptr; Ln, Ln1 : Double; begin Ln := -0.1; Ln1 := 1.0; while Ln1 /= Ln loop reset_iterator (My_Tasks, Iterator2); Ln := Ln1; Ln1 := 0.0; loop current_element (My_Tasks, Taskj2, Iterator2); if (Taskj2.priority >= Current_Task.priority) then Ln1 := Ln1 + Double'Ceiling (Ln / Double (Periodic_Task_Ptr (Taskj2).period)) * Double (Taskj2.capacity); end if; exit when is_last_element (My_Tasks, Iterator2); next_element (My_Tasks, Iterator2); end loop; end loop; return Ln1; end compute_L; function Compute_Wiq_preemptive (My_Tasks : in Tasks_Set; --all the task Current_Task : in Generic_Task_Ptr; --the task examine q : in Integer) return Double is Iterator2 : Tasks_Iterator; Taskj : Generic_Task_Ptr; Wiq_k, Wiq_k1 : Double; begin Wiq_k := -0.1; Wiq_k1 := 0.0; -- approximations for Wiq -- exit loop when approximations converge while Wiq_k1 /= Wiq_k loop reset_iterator (My_Tasks, Iterator2); Wiq_k := Wiq_k1; Wiq_k1 := Double ((q + 1) * Current_Task.capacity + Current_Task.blocking_time); -- Iterate on all tasks loop current_element (My_Tasks, Taskj, Iterator2); -- If Taskj is in hp(Taski) if (Taskj.priority > Current_Task.priority) then Wiq_k1 := Wiq_k1 + Double'Ceiling ((Wiq_k + Double (Periodic_Task_Ptr (Taskj).jitter)) / Double (Periodic_Task_Ptr (Taskj).period)) * Double (Taskj.capacity); end if; -- exit loop when there is no more task exit when is_last_element (My_Tasks, Iterator2); next_element (My_Tasks, Iterator2); end loop; end loop; return Wiq_k1; end Compute_Wiq_preemptive; procedure Compute_Response_Time (My_Scheduler : in Fixed_Priority_Scheduler; My_Tasks : in out Tasks_Set; Processor_Name : in Unbounded_String; Msg : in out Unbounded_String; Response_Time : out Response_Time_Table) is Tmp : Tasks_Set; Iterator1 : Tasks_Iterator; Taski : Generic_Task_Ptr; I : Response_Time_Range := 0; Li, Q_double, Wiq, Ri : Double := 0.0; Q_arrete, Q : Integer; begin initialize (Response_Time); Current_Processor_Name := Processor_Name; select_and_copy (My_Tasks, Tmp, Select_Cpu'Access); -- Set priority according to the scheduler -- if (My_Scheduler.parameters.scheduler_type = Deadline_Monotonic_Protocol) then Set_Priority_According_To_Dm (My_Scheduler, Tmp); else if (My_Scheduler.parameters.scheduler_type = Rate_Monotonic_Protocol) then Set_Priority_According_To_Rm (My_Scheduler, Tmp); end if; end if; sort (Tmp, Increasing_Priority'Access); -- Bibliographical references -- if (My_Scheduler.parameters.preemptive_type = not_preemptive) then -- Non preemptive case -- Msg := To_Unbounded_String (" (") & Lb_See (Current_Language) & To_Unbounded_String ("[1], page 36, ") & Lb_Equation (Current_Language); Msg := Msg & To_Unbounded_String ("13). "); else -- Preemptive case -- Msg := To_Unbounded_String (" (") & Lb_See (Current_Language) & To_Unbounded_String ("[2], page 3, ") & Lb_Equation (Current_Language); Msg := Msg & To_Unbounded_String ("4). "); end if; -- compute response time for each tasks -- reset_iterator (Tmp, Iterator1); loop -- Selection of the current task -- current_element (Tmp, Taski, Iterator1); -- Initialize response time for current task -- Response_Time.entries (I).data := 0.0; Response_Time.entries (I).item := Taski; Response_Time.nb_entries := Response_Time.nb_entries + 1; if (My_Scheduler.parameters.preemptive_type = not_preemptive) then -- Find the maximum for Ri in [0..Q] -- Q := 0; Li := compute_L (Tmp, Taski); loop Q_double := Double'Floor (Li / Double (Periodic_Task_Ptr (Taski).period)); Q_arrete := Integer (Q_double); Wiq := Compute_Wiq_non_preemptive (Tmp, Taski, Q); --Ri = Wiq + Ci - qTi -- Ri := Wiq + Double (Periodic_Task_Ptr (Taski).capacity) - Double (Q) * Double (Periodic_Task_Ptr (Taski).period); -- Is Ri greater than current maximum for Ri ? -- if (Ri > Response_Time.entries (I).data) then Response_Time.entries (I).data := Ri; end if; exit when Q = Q_arrete; Q := Q + 1; end loop; else Q := 0; loop Wiq := Compute_Wiq_preemptive (Tmp, Taski, Q); case Taski.task_type is when Periodic_Type => Ri := Wiq + Double (Periodic_Task_Ptr (Taski).jitter) - Double (Q) * Double (Periodic_Task_Ptr (Taski).period); when others => raise Constraint_Error; end case; -- Is Ri greater than current maximum for Ri ? -- if (Ri > Response_Time.entries (I).data) then Response_Time.entries (I).data := Ri; end if; exit when Wiq <= Double (Q + 1) * Double (Periodic_Task_Ptr (Taski).period); Q := Q + 1; end loop; end if; exit when is_last_element (Tmp, Iterator1); next_element (Tmp, Iterator1); I := I + 1; end loop; end Compute_Response_Time; 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 and -- only if Automatic_Assignment is requested -- 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.priority_assignment = manual_assignment then Fixed_Priority_Resource_Ptr (Si.Shared_Resources (K)). Priority_Ceiling := si.shared_resources(k).shared.Priority; else 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.critical_sections.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.critical_sections.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 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.scheduler_type = Deadline_Monotonic_Protocol) then Set_Priority_According_To_Dm (My_Scheduler, My_Tasks); else if (My_Scheduler.parameters.scheduler_type = 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.critical_sections.nb_entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).data.task_end) and (Si.Shared_Resources (Index1).Shared.critical_sections.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, Current_Time, a_item); 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.critical_sections. nb_entries - 1 loop if ( Si.Shared_Resources (I1).Shared.critical_sections. entries (I2).item = A_Tcb.Tsk.name) and (Current_Capacity < Si.Shared_Resources (I1).Shared.critical_sections. entries (Index2).data.task_end) and (Current_Capacity >= Si.Shared_Resources (I1).Shared.critical_sections. 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.critical_sections.nb_entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).data.task_begin) and (Si.Shared_Resources (Index1).Shared.critical_sections.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, Current_Time, a_item); 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.critical_sections.nb_entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).data.task_begin) and (Si.Shared_Resources (Index1).Shared.critical_sections.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_resource_task := A_Tcb.Tsk; add (Result.all, Current_Time, a_item); 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.critical_sections.nb_entries - 1 loop -- We are on a resource used by Task_Name -- Let find now the largest private section -- if (A_Resource.critical_sections.entries (I).item = Task_Name) then for J in 0 .. A_Resource.critical_sections.nb_entries - 1 loop if (A_Resource.critical_sections.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.critical_sections.entries (J).item); if A_Task2_Ptr.priority < A_Task1_Ptr.priority then Blocking_Time := Natural'Max (Blocking_Time, A_Resource.critical_sections.entries (J).data.task_end - A_Resource.critical_sections.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.critical_sections.nb_entries - 1 loop -- We found a given critical section : increase blocking --time ! -- if (A_Resource.critical_sections.entries (I).item = A_Task2.name) then Blocking_Time := Blocking_Time + A_Resource.critical_sections.entries (I).data. task_end - A_Resource.critical_sections.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.critical_sections.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.scheduler_type = Deadline_Monotonic_Protocol) then Set_Priority_According_To_Dm (My_Scheduler, Tmp); else if (My_Scheduler.parameters.scheduler_type = 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;