------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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-2023, 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 README.md -- -- 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 Scheduler_Interface; use Scheduler_Interface; with Multiprocessor_Services_Interface; use Multiprocessor_Services_Interface; use Multiprocessor_Services_Interface.Scheduling_Result_Per_Processor_Package; with framework; use framework; with processor_set; use processor_set; with time_unit_events; use time_unit_events; use time_unit_events.time_unit_package; with natural_util; use natural_util; with Processor_Interface; use Processor_Interface; with Core_Units; use Core_Units.Core_Units_Table_Package; with Processor_Interface; use Processor_Interface; with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; with Tasks; use Tasks; with task_set; use task_set; with version; use version; with Text_IO; use Text_IO; with feasibility_test.feasibility_interval; use feasibility_test.feasibility_interval; with unbounded_strings; use unbounded_strings; package body Ellidiss_Tools is -- -- function Get_Offline_Scheduling_Period (A_Processor : in Generic_Processor_Ptr) return Natural is -- scheduling_Period : Natural := Default_Scheduling_Period; -- -- core : Core_Unit_Ptr; -- -- offline_scheduler : Hierarchical_offline_Scheduler; -- offline_scheduling_table : scheduling_table_ptr; -- -- tmp_string : Unbounded_String; -- begin -- Put_Line (To_String (A_Processor.name)); -- -- core := Mono_Core_Processor_Ptr(A_Processor).core; -- -- Put_Line (To_String (core.name)); -- -- offline_scheduler := Hierarchical_offline_Scheduler (extended_Core_Unit_Ptr (core).scheduler.all); -- --offline_scheduler := extended_Core_Unit_Ptr (core).scheduler.all; -- -- offline_scheduling_table := Get_event_table (offline_scheduler); -- -- Display_Scheduling (offline_scheduling_table); -- --indexed_tables.Put (offline_scheduling_table); -- --Put (Item => offline_scheduling_table.Nb_Entries); -- -- --Text_IO.put (Natural'Image (Natural(offline_scheduling_table.Nb_Entries - 1))); -- -- --for I in 0 .. offline_scheduling_table.Nb_Entries - 1 loop -- --tmp_string := xml_string (offline_scheduling_table.entries (I).data); -- --Put_line (To_String(tmp_string)); -- --end loop; -- -- return scheduling_Period; -- end Get_Offline_Scheduling_Period; -- -- function Get_Cyclic_Scheduling_Period (My_Address_Spaces : in Address_Spaces_Set) return Natural is -- scheduling_Period : Natural := Default_Scheduling_Period; -- -- An_Address_Space : Address_Space_Ptr; -- -- Ad_Iterator : address_spaces_iterator; -- tmp_value : Natural := 0; -- -- --position : Address_Spaces_Range; -- begin -- --position := get_number_of_elements (My_Address_Spaces); -- -- -- --get_element_number (My_Address_Spaces, An_Address_Space, position); -- -- reset_iterator (My_Address_Spaces, Ad_Iterator); -- loop -- current_element (My_Address_Spaces, An_Address_Space, Ad_Iterator); -- -- -- get the quantum -- tmp_value := tmp_value + An_Address_Space.scheduling.quantum; -- -- exit when is_last_element (My_Address_Spaces, Ad_Iterator); -- next_element (My_Address_Spaces, Ad_Iterator); -- end loop; -- -- if (tmp_value /= 0) then -- scheduling_Period := tmp_value; -- end if; -- -- return scheduling_Period; -- end Get_Cyclic_Scheduling_Period; function Get_Scheduling_Period (A_Sys : in system; A_Processor : generic_processor_ptr; Max_Scheduling_Period : in Natural := 0) return Natural is Period : Natural; Task_Iterator : tasks_iterator; Task_Ptr : generic_task_ptr; Empty_Task_Set : Boolean := True; current_scheduler : schedulers_type; begin -- test if the task set per processor is empty reset_iterator (A_Sys.Tasks, Task_Iterator); loop current_element (A_Sys.Tasks, Task_Ptr, Task_Iterator); if (Task_Ptr.cpu_name = A_Processor.name) or (A_Processor.name = empty_string) then Empty_Task_Set := False; end if; exit when is_last_element (A_Sys.Tasks, Task_Iterator); next_element (A_Sys.Tasks, Task_Iterator); end loop; if (Empty_Task_Set = False) then begin -- check if the scheduler if A_Processor.processor_type = monocore_type then current_scheduler := mono_core_processor_ptr (A_Processor).core.scheduling .scheduler_type; if (current_scheduler = hierarchical_offline_protocol) then -- arinc 653 scheduler --Period := Get_Offline_Scheduling_Period (A_Processor); raise Invalid_Scheduling_Period; else if (current_scheduler = hierarchical_cyclic_protocol) then --Period := Get_Cyclic_Scheduling_Period (A_Sys.Address_Spaces); raise Invalid_Scheduling_Period; end if; end if; else for i in 0 .. multi_cores_processor_ptr (A_Processor).cores.nb_entries - 1 loop current_scheduler := multi_cores_processor_ptr (A_Processor).cores.entries (i) .scheduling .scheduler_type; if (current_scheduler = hierarchical_offline_protocol) then raise Invalid_Scheduling_Period; else if (current_scheduler = hierarchical_cyclic_protocol) then raise Invalid_Scheduling_Period; end if; end if; end loop; end if; Period := scheduling_period (A_Sys.Tasks, A_Processor.name); if ((Max_Scheduling_Period /= 0) and (Period > Max_Scheduling_Period)) then raise Invalid_Scheduling_Period; end if; exception when task_must_be_periodic => raise Invalid_Scheduling_Period; end; else raise Invalid_Scheduling_Period; end if; return (Period); end Get_Scheduling_Period; function Get_Max_Scheduling_Period (Sys : in out System; Max_Scheduling_Period : in Natural := 0) return Natural is A_Processor : Generic_Processor_Ptr; Processor_Iterator : Processors_Iterator; Tmp_Period : Natural; scheduling_period : Natural := 0; begin reset_iterator (Sys.Processors, Processor_Iterator); loop current_element (Sys.Processors, A_Processor, Processor_Iterator); begin Tmp_Period := Get_Scheduling_Period (Sys, A_Processor, Max_Scheduling_Period); --Put_line ("Tmp_Period = " & format (Tmp_Period)); exception when Invalid_Scheduling_Period => --Put_line ("Invalid_Scheduling_Period"); Tmp_Period := Max_Scheduling_Period; end; if (Tmp_Period > scheduling_period) then scheduling_period := Tmp_Period; end if; exit when is_last_element (Sys.Processors, Processor_Iterator); next_element (Sys.Processors, Processor_Iterator); end loop; return scheduling_period; end Get_Max_Scheduling_Period; procedure Write_Xml_Event_Table (Sys : in out system; Result : in out Unbounded_String; Max_Scheduling_Period : in Natural := 0) is A_Processor : generic_processor_ptr; An_Event : time_unit_event_ptr; validity : Unbounded_String; Tmp_Period : Natural; --Xml_File : File_Type; begin Result := Result & "" & unbounded_lf; -- Export event table for each processor -- for I in 0 .. framework.sched.nb_entries - 1 loop A_Processor := search_processor (Sys.Processors, framework.sched.entries (I).item.name); if (framework.sched.entries (I).data.error_msg = empty_string) then --Put_Line ("Processor name" & A_Processor.name); begin Tmp_Period := Get_Scheduling_Period (Sys, A_Processor, Max_Scheduling_Period); validity := To_Unbounded_String ("true"); exception when Invalid_Scheduling_Period => Tmp_Period := Max_Scheduling_Period; validity := To_Unbounded_String ("false"); end; Result := Result & " " & unbounded_lf; Result := Result & " FALSE" & unbounded_lf; Result := Result & " " & unbounded_lf; for J in 0 .. framework.sched.entries (I).data.result.nb_entries - 1 loop -- The event to compute -- An_Event := framework.sched.entries (I).data.result.entries (J).data; Result := Result & " " & format (Natural (framework.sched.entries (I).data.result.entries (J).item)) & "" & unbounded_lf; Result := Result & " " & unbounded_lf; Result := Result & " " & To_Unbounded_String (time_unit_event_type'image (An_Event.type_of_event)) & "" & unbounded_lf; case An_Event.type_of_event is when buffer_overflow => Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; Result := Result & " " & format (Natural (An_Event.overflow_write_size)) & "" & unbounded_lf; when buffer_underflow => Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; Result := Result & " " & format (Natural (An_Event.underflow_read_size)) & "" & unbounded_lf; when start_of_task_capacity => Result := Result & " " & unbounded_lf; when end_of_task_capacity => Result := Result & " " & unbounded_lf; when write_to_buffer => Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; Result := Result & " " & format (Natural (An_Event.write_size)) & "" & unbounded_lf; when read_from_buffer => Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; Result := Result & " " & format (Natural (An_Event.read_size)) & "" & unbounded_lf; when context_switch_overhead => Result := Result & " " & unbounded_lf; when running_task => Result := Result & " " & An_Event.running_core & "" & unbounded_lf; Result := Result & " " & unbounded_lf; Result := Result & " " & format (Natural (An_Event.current_priority)) & "" & unbounded_lf; when task_activation => Result := Result & " " & unbounded_lf; when allocate_resource => Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; when release_resource => Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; when wait_for_resource => Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; when send_message => Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; when receive_message => Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; when wait_for_memory => Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; when address_space_activation => Result := Result & " " & An_Event.activation_address_space & "" & unbounded_lf; Result := Result & " " & format (Natural (An_Event.duration)) & "" & unbounded_lf; when discard_missed_deadline => Result := Result & " " & unbounded_lf; when preemption => null; when energy => null; end case; Result := Result & " " & unbounded_lf; end loop; Result := Result & " " & unbounded_lf; Result := Result & " " & unbounded_lf; else Result := Result & " " & unbounded_lf; Result := Result & " TRUE" & unbounded_lf; Result := Result & " " & framework.sched.entries (I).data.error_msg & "" & unbounded_lf; Result := Result & " " & unbounded_lf; end if; end loop; Result := Result & "" & unbounded_lf; end Write_Xml_Event_Table; procedure Set_Default_Scheduling_Period (Scheduling_Period : in Natural) is begin Default_Scheduling_Period := Scheduling_Period; end Set_Default_Scheduling_Period; function Get_Default_Scheduling_Period return Natural is begin return Default_Scheduling_Period; end Get_Default_Scheduling_Period; function CheddarKernel_version return String is begin return cheddar_version & "." & CheddarKernel_Verion; end CheddarKernel_version; end Ellidiss_Tools;