------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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: 523 $ -- $Date: 2012-09-26 15:09:39 +0200 (Wed, 26 Sep 2012) $ -- $Author: fotsing $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Xml_Tag; use Xml_Tag; with Tasks; use Tasks; with Task_Set; use Task_Set; use Task_Set.Generic_Task_Set; with resources; use resources; with Resource_Set; use Resource_Set; use Resource_Set.Generic_Resource_Set; with Processor_Set; use Processor_Set; use Processor_Set.Generic_Processor_Set; with Translate; use Translate; with unbounded_strings; use unbounded_strings; with Framework_Config; use Framework_Config; with Scheduler_Interface; use Scheduler_Interface; with Scheduler; use Scheduler; with Scheduler_builder; use Scheduler_builder; with Scheduler.Fixed_Priority; use Scheduler.Fixed_Priority; with Scheduling_Analysis; use Scheduling_Analysis; with Scheduling_Analysis.extended.resource_analysis; use Scheduling_Analysis.extended.resource_analysis; use Scheduling_Analysis.Deadlock_Package; use Scheduling_Analysis.Double_Tasks_Parameters_Package; use Scheduling_Analysis.Priority_Inversion_List_Package; use Scheduling_Analysis.Ceiling_Priority_Table_Package; with Multiprocessor_Services_Interface; use Multiprocessor_Services_Interface; use Multiprocessor_Services_Interface.Scheduling_Result_Per_Processor_Package; with priority_assignment.dm; use priority_assignment.dm; with priority_assignment.rm; use priority_assignment.rm; with priority_assignment.ceiling_priority; use priority_assignment.ceiling_priority; with feasibility_test.worst_case_blocking_time; use feasibility_test.worst_case_blocking_time; with framework; use framework; with Call_Scheduling_Framework; use Call_Scheduling_Framework; with double_util; use double_util; with Ada.Numerics.Aux; use Ada.Numerics.Aux; with Debug; use Debug; with text_io; use text_io; package body Call_Resource_Framework is procedure Compute_resource_ceiling_priority (Sys : in out System; Result : in out Unbounded_String; A_Processor : in Generic_Processor_Ptr; Inject_priority : in Boolean; Output : in Output_Format := String_Output) is A_resource : Generic_resource_Ptr; Has_Raised_Exception : Boolean := False; Msg : Unbounded_String; Ceiling_Priorities : Ceiling_Priority_Table; begin Put_Debug ("Call Compute_Resource_Ceiling_Priority "); if Output = Xml_Output then Set_Tag; else Set_Empty; end if; -- And now, compute ceiling priority -- Result := Result & Start_Line & Lb_Minus & Lb_Ceiling_Priority (Current_Language) & Start_Ref & To_Unbounded_String (" (") & Lb_See (Current_Language) & To_Unbounded_String ("[3]) ") & End_Ref & Lb_Colon & unbounded_lf; Msg := empty_string; Compute_Ceiling_Priority ( Sys.Tasks, Sys.Resources, A_Processor.name, Msg, Ceiling_Priorities); if Msg /= empty_string then Has_Raised_Exception := True; Result := Result & Msg; end if; -- Display all resource ceiling priority -- for I in 0 .. Ceiling_Priorities.nb_entries-1 loop Result := Result & Start_Task & To_Unbounded_String (" ") & Ceiling_Priorities.entries (I).resource_name & To_Unbounded_String (" =>") & Integer'Image (Integer (Ceiling_Priorities.entries (I).ceiling_priority)) & End_Task & unbounded_lf; end loop; Result := Result & unbounded_lf & End_Line & unbounded_lf & unbounded_lf; -- Update ceiling priority -- if Inject_priority then if Has_Raised_Exception then Result := Result & unbounded_lf & Start_Line & Lb_ceiling_priority_Inject_Failed (Current_Language) & End_Line & unbounded_lf & End_Block & unbounded_lf; else for I in 0 .. Ceiling_Priorities.nb_entries-1 loop A_resource := Search_resource (Sys.resources, Ceiling_Priorities.entries (I).resource_name); A_resource.priority := Ceiling_Priorities.entries (I).ceiling_priority; end loop; Result := Result & unbounded_lf & Start_Line & Lb_ceiling_priority_Inject_Success (Current_Language) & End_Line & unbounded_lf & End_Block & unbounded_lf; end if; end if; end Compute_resource_ceiling_priority; procedure Compute_Worst_Case_Blocking_Time (Sys : in out System; Result : in out Unbounded_String; A_Processor : in Generic_Processor_Ptr; Inject_Blocking_Time : in Boolean; Output : in Output_Format := String_Output) is A_Task : Generic_Task_Ptr; Has_Raised_Exception : Boolean := False; Msg : Unbounded_String; Blocking_Time : Blocking_Time_Table; A_Scheduler : Generic_Scheduler_Ptr; begin Put_Debug ("Call Compute_Worst_Case_Blocking_Time"); if Output = Xml_Output then Set_Tag; else Set_Empty; end if; -- And now, compute blocking time -- Result := Result & Start_Line & Lb_Minus & Lb_Worst_Case_Blocking_Time (Current_Language) & Start_Ref & To_Unbounded_String (" (") & Lb_See (Current_Language) & To_Unbounded_String ("[3]) ") & End_Ref & Lb_Colon & unbounded_lf; Msg := empty_string; a_scheduler:=build_a_scheduler(A_Processor); Compute_Blocking_Time (A_Scheduler, Sys.Tasks, Sys.Resources, A_Processor.name, Msg, Blocking_Time); free(a_scheduler); if Msg /= empty_string then Has_Raised_Exception := True; Result := Result & Msg; end if; -- Display all task blocking time -- for I in 0 .. Blocking_Time_Range (Get_Number_Of_Task_From_Processor (Sys.Tasks, A_Processor.name) - 1) loop if (Blocking_Time.entries (I).item /= null) then Result := Result & Start_Task & To_Unbounded_String (" ") & Blocking_Time.entries (I).item.name & To_Unbounded_String (" =>") & Integer'Image (Integer (Blocking_Time.entries (I).data)) & End_Task & unbounded_lf; end if; end loop; Result := Result & unbounded_lf & End_Line & unbounded_lf & unbounded_lf; -- Update blocking time -- if Inject_Blocking_Time then if Has_Raised_Exception then Result := Result & unbounded_lf & Start_Line & Lb_Blocking_Time_Inject_Failed (Current_Language) & End_Line & unbounded_lf & End_Block & unbounded_lf; else for I in 0 .. Blocking_Time_Range (Get_Number_Of_Task_From_Processor (Sys.Tasks, A_Processor.name) - 1) loop if (Blocking_Time.entries (I).item /= null) then A_Task := Search_Task (Sys.Tasks, Blocking_Time.entries (I).item.name); A_Task.blocking_time := Natural (Blocking_Time.entries (I).data); end if; end loop; Result := Result & unbounded_lf & Start_Line & Lb_Blocking_Time_Inject_Success (Current_Language) & End_Line & unbounded_lf & End_Block & unbounded_lf; end if; end if; exception when Invalid_Scheduler => Result := Result & unbounded_lf & Lb_Compute_Blocking_Error2 (Current_Language) & unbounded_lf; end Compute_Worst_Case_Blocking_Time; procedure Compute_Simulation_Blocking_Time (Sys : in out System; Result : in out Unbounded_String; A_Processor : in Generic_Processor_Ptr; Worst_Case : in Boolean; Best_Case : in Boolean; Average_Case : in Boolean; Output : in Output_Format := String_Output) is A_Task : Generic_Task_Ptr; My_Iterator : Tasks_Iterator; Min : Natural := 0; Max : Natural := 0; Average : Double := 0.0; begin Put_Debug ("Call Compute_Simulation_Blocking_Time"); if Output = Xml_Output then Set_Tag; else Set_Empty; end if; for J in 0 .. Sched.nb_entries - 1 loop if Sched.entries (J).item.name = A_Processor.name then Result := Result & Start_Line & Lb_Minus & Lb_Simulation_Blocking_Time (Current_Language) & Lb_Colon & unbounded_lf; reset_iterator (Sys.Tasks, My_Iterator); loop current_element (Sys.Tasks, A_Task, My_Iterator); if (A_Processor.name = A_Task.cpu_name) then Blocking_Time_From_Simulation (A_Task, Sys.Resources, Sched.entries (J).data.result, Max, Min, Average); Result := Result & Start_Task & To_Unbounded_String (" ") & A_Task.name & To_Unbounded_String (" =>"); if Worst_Case then Result := Result & Max'Img & To_Unbounded_String ("/worst "); end if; if Best_Case then Result := Result & Min'Img & To_Unbounded_String ("/best "); end if; if Average_Case then Result := Result & format (Average) & To_Unbounded_String ("/average "); end if; Result := Result & End_Task & unbounded_lf; end if; exit when is_last_element (Sys.Tasks, My_Iterator); next_element (Sys.Tasks, My_Iterator); end loop; end if; end loop; end Compute_Simulation_Blocking_Time; procedure Priority_Inversion_Detection (Sys : in out System; Result : in out Unbounded_String; A_Processor : in Generic_Processor_Ptr; Output : in Output_Format := String_Output) is Priority_Inversion : Priority_Inversion_List; Item : Priority_Inversion_Item_Ptr; Tmp_Tasks : Tasks_Set; My_Scheduler : Generic_Scheduler_Ptr; begin Put_Debug ("Call Priority_Inversion_Detection"); if Output = Xml_Output then Set_Tag; else Set_Empty; end if; Current_Processor_Name := A_Processor.name; select_and_copy (Sys.Tasks, Tmp_Tasks, Select_Cpu'Access); -- Set priority according to the scheduler -- my_scheduler:=build_a_scheduler(A_Processor); if (Get_Name (My_Scheduler.all) = Deadline_Monotonic_Protocol) then Set_Priority_According_To_Dm (Tmp_Tasks); else if (Get_Name (My_Scheduler.all) = Rate_Monotonic_Protocol) then Set_Priority_According_To_Rm (Tmp_Tasks); end if; end if; for J in 0 .. Sched.nb_entries - 1 loop if Sched.entries (J).item.name = A_Processor.name then Priority_Inversion := Priority_Inversion_From_Simulation (Tmp_Tasks, Sys.Resources, A_Processor.name, Sched.entries (J).data.result); if is_empty (Priority_Inversion) then Result := Result & Lb_No_Priority_Inversion_Found (Current_Language) & unbounded_lf; else Result := Result & Start_Line & Lb_Minus & Lb_Simulation_Priority_Inversion (Current_Language) & Lb_Colon & unbounded_lf; while not is_empty (Priority_Inversion) loop Item := get_head (Priority_Inversion); Result := Result & To_Unbounded_String (" ") & Item.task_name & Lb_Has_Priority_Inversion (Current_Language) & Item.resource_name & Lb_From_The_Time (Current_Language) & To_Unbounded_String (Item.start_time'Img) & Lb_To_The_Time (Current_Language) & To_Unbounded_String (Item.end_time'Img) & Lb_Dot & unbounded_lf; delete (Priority_Inversion, Item); end loop; end if; end if; end loop; free (Tmp_Tasks); free (my_scheduler); Result := Result & unbounded_lf & unbounded_lf; end Priority_Inversion_Detection; procedure Deadlock_Detection (Sys : in out System; Result : in out Unbounded_String; A_Processor : in Generic_Processor_Ptr; Output : in Output_Format := String_Output) is Deadlock : Deadlock_List; Item : Deadlock_Item_Ptr; begin Put_Debug ("Call Deadlock_Detection"); if Output = Xml_Output then Set_Tag; else Set_Empty; end if; for J in 0 .. Sched.nb_entries - 1 loop if Sched.entries (J).item.name = A_Processor.name then Deadlock := Deadlock_From_Simulation (Sys.Tasks, Sys.Resources, A_Processor.name, Sched.entries (J).data.result); if is_empty (Deadlock) then Result := Result & Lb_No_Deadlock_Found (Current_Language) & unbounded_lf; else Result := Result & Start_Line & Lb_Minus & Lb_Simulation_Deadlock (Current_Language) & Lb_Colon & unbounded_lf; while not is_empty (Deadlock) loop Item := get_head (Deadlock); Result := Result & To_Unbounded_String (" ") & Lb_Deadlock_At_Time (Current_Language) & To_Unbounded_String (Item.time'Img) & Lb_Colon; Result := Result & " " & Item.task_name; Result := Result & lb_wait_for(current_language) & Item.resource_name & Lb_Dot & unbounded_lf; delete (Deadlock, Item); end loop; end if; end if; end loop; end Deadlock_Detection; end Call_Resource_Framework;