------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 CNRS 6285, Universite 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 $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Tasks; use Tasks; with unbounded_strings; use unbounded_strings; with Ada.Numerics.Aux; use Ada.Numerics.Aux; with Framework_Config; use Framework_Config; with Processors; use Processors; with Scheduler; use Scheduler; with scheduler_builder; use scheduler_builder; with Buffers; use Buffers; use Buffers.Buffer_Roles_Package; with feasibility_test.periodic_task_worst_case_response_time; use feasibility_test.periodic_task_worst_case_response_time; with Task_Dependencies; use Task_Dependencies; use Task_Dependencies.Half_Dep_Set; with dependencies; use dependencies; package body Dependency_Services is procedure Set_Parameters_According_To_Chetto (My_Dependencies : in Tasks_Dependencies_Ptr; My_Tasks : in out Tasks_Set; Compute_Deadlines : in Boolean; Compute_Priorities : in Boolean) is Leaf, Step : Tasks_Set; Previous : Tasks_Set; Real_Left, Real_Right, Left, Right : Generic_Task_Ptr; Ite1, Ite2 : Tasks_Iterator; begin if Is_Cyclic (My_Dependencies) then raise Cyclic_Graph_Error; end if; dependencies_same_periods_control (my_tasks, my_dependencies, empty_string); -- Assume the graph is acyclic. -- Extract leaves of the graph and update deadline -- of previous node -- Step := Get_Leaf_Tasks (My_Dependencies); while not is_empty (Step) loop reset (Leaf); duplicate (Step, Leaf); reset (Step); reset_iterator (Leaf, Ite1); for I in 0 .. get_number_of_elements (Leaf) - 1 loop -- The task to be updated -- current_element (Leaf, Right, Ite1); -- Take previous tasks -- if Has_Predecessor (My_Dependencies, Right) then reset (Previous); Previous := Get_Predecessors_List (My_Dependencies, Right); reset_iterator (Previous, Ite2); for J in 0 .. get_number_of_elements (Previous) - 1 loop current_element (Previous, Left, Ite2); add (Step, Left); Real_Left := Search_Task (My_Tasks, Left.name); Real_Right := Search_Task (My_Tasks, Right.name); if Compute_Priorities then if Right.priority >= 1 then Real_Left.priority := Priority_Range'Max (Real_Left.priority, Real_Right.priority + 1); end if; end if; if Compute_Deadlines then if (Integer (real_right.deadline) - Integer (real_right.capacity) < 0) then raise deadline_exhausted; end if; Real_Left.deadline := Natural'Min (Real_Left.deadline, Real_Right.deadline - Real_Right.capacity); end if; next_element (Previous, Ite2); end loop; end if; next_element (Leaf, Ite1); end loop; end loop; end Set_Parameters_According_To_Chetto; function Get_Response_Time (Rtn : in Response_Time_Table; A_Task : Generic_Task_Ptr) return Double is begin for I in Response_Time_Range loop if (Rtn.entries (I).item.name = A_Task.name) then return Rtn.entries (I).data; end if; end loop; raise Task_Set.Task_Not_Found; end Get_Response_Time; procedure Inject_Response_Time_Into_Jitter (My_Dependencies : in Tasks_Dependencies_Ptr; My_Tasks : in out Tasks_Set; Rtn : in Response_Time_Table) is Max_Jitter : Double := 0.0; Ite1, Ite2 : Tasks_Iterator; Previous, A_Task : Generic_Task_Ptr; Pred : Tasks_Set; begin -- Scan each task. If a task has a predecessor, set its jitter -- to the response time of its predecessors -- reset_iterator (My_Tasks, Ite1); loop current_element (My_Tasks, A_Task, Ite1); -- Find maximum response time of predecessors -- if Has_Predecessor (My_Dependencies, A_Task) then reset (Pred); Pred := Get_Predecessors_List (My_Dependencies, A_Task); if not is_empty (Pred) then reset_iterator (Pred, Ite2); Max_Jitter := 0.0; for I in 0 .. get_number_of_elements (Pred) - 1 loop current_element (Pred, Previous, Ite2); Max_Jitter := Double'max (max_jitter, get_response_time (rtn, previous)); next_element (Pred, Ite2); end loop; -- set jitter with max_jitter -- case A_Task.task_type is when Periodic_Type | poisson_type | sporadic_type => Periodic_Task_Ptr (A_Task).jitter := Natural'Max (Periodic_Task_Ptr (A_Task).jitter, Natural (Max_Jitter)); when others => raise task_model_error; end case; end if; end if; exit when is_last_element (My_Tasks, Ite1); next_element (My_Tasks, Ite1); end loop; end Inject_Response_Time_Into_Jitter; procedure Compute_All_Response_Times (my_sys : in out system; my_tasks : in out tasks_set; msg : in out Unbounded_String; rtn : in out response_time_table) is I : Natural; K, J : Response_Time_Range; A_Processor : Generic_Processor_Ptr; My_Iterator : Processors_Iterator; type Rt is array (0 .. Max_Processors - 1) of Response_Time_Table; Rt_By_Processor : Rt; begin -- Compute tasks -- I := 0; reset_iterator (My_sys.Processors, My_Iterator); loop current_element (My_sys.Processors, A_Processor, My_Iterator); Msg := empty_string; if Get_Number_Of_Task_From_Processor (My_Tasks, A_Processor.name) > 0 then My_sys.tasks:=my_tasks; Compute_Response_Time (build_a_scheduler(A_Processor), My_sys, A_Processor.name, Msg, Rt_By_Processor (I)); end if; exit when is_last_element (My_sys.Processors, My_Iterator); next_element (My_sys.Processors, My_Iterator); I := I + 1; end loop; I := 0; K := 0; reset_iterator (My_sys.Processors, My_Iterator); loop J := 0; current_element (My_sys.Processors, A_Processor, My_Iterator); for L in 0 .. (Get_Number_Of_Task_From_Processor (My_Tasks, A_Processor.name) - 1) loop Rtn.entries (K) := Rt_By_Processor (I).entries (J); Rtn.nb_entries := Rtn.nb_entries + 1; K := K + 1; J := J + 1; end loop; exit when is_last_element (My_sys.Processors, My_Iterator); next_element (My_sys.Processors, My_Iterator); I := I + 1; end loop; end Compute_All_Response_Times; procedure Compute_End_To_End_Response_Time (my_sys : in out system; one_step : in Boolean; update_tasks_set : in Boolean; msg : in out Unbounded_String; rt : in out response_time_table) is Rtn, Rtn1 : Response_Time_Table; Tmp_Tasks : Tasks_Set; begin initialize (Rtn); initialize (Rtn1); dependencies_same_periods_control (my_sys.tasks, my_sys.dependencies, empty_string); dependencies_task_models_control (my_sys.tasks, my_sys.dependencies, empty_string); if not Update_Tasks_Set then duplicate (My_sys.Tasks, Tmp_Tasks); end if; Compute_All_Response_Times (My_sys, My_sys.Tasks, Msg, Rtn); loop -- Stop when end to end response time do not change -- from an iteration to another -- exit when Is_Equal (Rtn, Rtn1); -- Update jitter .... -- if not Update_Tasks_Set then Inject_Response_Time_Into_Jitter (My_sys.Dependencies, Tmp_Tasks, Rtn); else inject_response_time_into_jitter (my_sys.dependencies, my_sys.tasks, rtn); end if; if One_Step then exit; end if; Rtn1 := Rtn; initialize (Rtn); if not Update_Tasks_Set then Compute_All_Response_Times (My_sys, tmp_tasks, Msg, Rtn); else Compute_All_Response_Times (My_sys, my_sys.tasks, Msg, Rtn); end if; -- Stop when all deadlines are missed -- exit when All_Deadlines_Missed (Rtn); end loop; Rt := Rtn; end Compute_End_To_End_Response_Time; function All_Deadlines_Missed (Rtn : in Response_Time_Table) return Boolean is begin for I in 0 .. Rtn.nb_entries - 1 loop if rtn.entries (i).data < Double (rtn.entries (i).item.deadline) then return False; end if; end loop; return True; end All_Deadlines_Missed; function Is_Equal (Rtn : in Response_Time_Table; Rtn1 : in Response_Time_Table) return Boolean is begin if Rtn.nb_entries /= Rtn1.nb_entries then return False; end if; for I in 0 .. Rtn.nb_entries - 1 loop if Rtn.entries (I).data /= Rtn1.entries (I).data then return False; end if; end loop; return True; end Is_Equal; -- -- Check that all task of a dependency graph have the same type -- procedure Dependencies_Task_Models_Control (My_Tasks : in Tasks_Set; My_Deps : in Tasks_Dependencies_Ptr; Processor_Name : in Unbounded_String) is My_Iterator1 : Tasks_Dependencies_Iterator; A_Half_Dep : Dependency_Ptr; Real_Task1, Real_Task2 : Generic_Task_Ptr; begin if not is_empty (My_Deps.Depends) then reset_iterator (My_Deps.Depends, My_Iterator1); loop current_element (my_deps.depends, a_half_dep, my_iterator1); if (A_Half_Dep.type_of_dependency = precedence_Dependency) then real_task1 := search_task (my_tasks, a_half_dep.precedence_source.name); real_task2 := search_task (my_tasks, a_half_dep.precedence_sink.name); if (real_task1.cpu_name = Processor_Name) or (real_task2.cpu_name = Processor_Name) or (Processor_Name = empty_string) then if real_task1.task_type /= real_task2.task_type then raise task_model_error; end if; end if; end if; exit when is_last_element (My_Deps.Depends, My_Iterator1); next_element (My_Deps.Depends, My_Iterator1); end loop; end if; end Dependencies_Task_Models_Control; procedure dependencies_same_periods_control (My_Tasks : in Tasks_Set; My_Deps : in Tasks_Dependencies_Ptr; Processor_Name : in Unbounded_String) is My_Iterator1 : Tasks_Dependencies_Iterator; A_Half_Dep : Dependency_Ptr; Real_Task1, Real_Task2 : Generic_Task_Ptr; period1, period2 : natural; begin if not is_empty (My_Deps.Depends) then reset_iterator (My_Deps.Depends, My_Iterator1); loop current_element (my_deps.depends, a_half_dep, my_iterator1); if (A_Half_Dep.type_of_dependency = precedence_Dependency) then real_task1 := search_task (my_tasks, a_half_dep.precedence_source.name); real_task2 := search_task (my_tasks, a_half_dep.precedence_sink.name); if (real_task1.cpu_name = Processor_Name) or (real_task2.cpu_name = Processor_Name) or (Processor_Name = empty_string) then if real_task1.task_type = aperiodic_type then period1:=0; else period1:=periodic_task_ptr(real_task1).period; end if; if real_task2.task_type = aperiodic_type then period2:=0; else period2:=periodic_task_ptr(real_task2).period; end if; if period1/=period2 then raise Dependencies_Period_Error; end if; end if; end if; exit when is_last_element (My_Deps.Depends, My_Iterator1); next_element (My_Deps.Depends, My_Iterator1); end loop; end if; end dependencies_same_periods_control; procedure dependencies_harmonic_periods_control (my_tasks : in tasks_set; my_deps : in tasks_dependencies_ptr; processor_name : in Unbounded_String) is my_iterator1 : tasks_dependencies_iterator; a_half_dep : dependency_ptr; real_task1, real_task2 : generic_task_ptr; period1, period2, harmonic : Natural; begin if not is_empty (my_deps.depends) then reset_iterator (my_deps.depends, my_iterator1); loop current_element (my_deps.depends, a_half_dep, my_iterator1); if (a_half_dep.type_of_dependency = precedence_dependency) then real_task1 := search_task (my_tasks, a_half_dep.precedence_source.name); real_task2 := search_task (my_tasks, a_half_dep.precedence_sink.name); if (real_task1.cpu_name = processor_name) or (real_task2.cpu_name = processor_name) or (processor_name = empty_string) then if real_task1.task_type = aperiodic_type then period1 := 0; else period1 := periodic_task_ptr (real_task1).period; end if; if real_task2.task_type = aperiodic_type then period2 := 0; else period2 := periodic_task_ptr (real_task2).period; end if; if period1 > period2 then harmonic := period1 mod period2; else harmonic := period2 mod period1; end if; if harmonic /= 0 then raise dependencies_period_error; end if; end if; end if; exit when is_last_element (my_deps.depends, my_iterator1); next_element (my_deps.depends, my_iterator1); end loop; end if; end dependencies_harmonic_periods_control; procedure Periodic_Buffer_Control (My_Tasks : in Tasks_Set; A_Buffer : in Buffer_Ptr) is Iterator1 : Tasks_Iterator; Task1 : Generic_Task_Ptr; begin for I in 0 .. A_Buffer.roles.nb_entries - 1 loop reset_iterator (My_Tasks, Iterator1); loop current_element (My_Tasks, Task1, Iterator1); if (Task1.name = A_Buffer.roles.entries (I).item) then if (Task1.task_type /= Periodic_Type) then raise Task_Must_Be_Periodic; end if; end if; exit when is_last_element (My_Tasks, Iterator1); next_element (My_Tasks, Iterator1); end loop; end loop; end Periodic_Buffer_Control; end Dependency_Services;