------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real-time scheduling analysis tool. -- This program provides services to automatically check schedulability and -- other performance criteria of real-time architecture models. -- -- Copyright (C) 2002-2020, Frank Singhoff, Alain Plantec, Jerome Legrand, -- Hai Nam Tran, Stephane Rubini -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR 6285, Université de Bretagne Occidentale -- -- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt -- -- 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$ -- $Date$ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ package body feasibility_test.worst_case_blocking_time is procedure Compute_Blocking_Time (My_Scheduler : in Generic_Scheduler_ptr; 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 begin case my_scheduler.parameters.scheduler_type is when Rate_Monotonic_Protocol | Deadline_Monotonic_Protocol | Posix_1003_Highest_Priority_First_Protocol => Compute_Blocking_Time(fixed_priority_scheduler(my_scheduler.all), my_tasks, my_resources, processor_name, msg, blocking_time); when others => raise Invalid_Scheduler; end case; end Compute_Blocking_Time; 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 (Tmp); else if (My_Scheduler.parameters.scheduler_type = Rate_Monotonic_Protocol) then Set_Priority_According_To_Rm (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; end feasibility_test.worst_case_blocking_time;