------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 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 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 Ada.IO_Exceptions; use Ada.IO_Exceptions; with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.Current_Exception; use GNAT.Current_Exception; with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.String_Split; use GNAT.String_Split; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with version; use version; with framework_config; use framework_config; with systems; use systems; with task_set; use task_set; with processors; use processors; with processor_set; use processor_set; use processor_set.generic_processor_set; with buffer_set; use buffer_set; with resource_set; use resource_set; with address_space_set; use address_space_set; with xml_generic_parsers; use xml_generic_parsers; with xml_generic_parsers.architecture; use xml_generic_parsers.architecture; with xml_generic_parsers.event_table; use xml_generic_parsers.event_table; with aadl_parsers; use aadl_parsers; with Text_IO; use Text_IO; with unbounded_strings; use unbounded_strings; use unbounded_strings.unbounded_string_list_package; with debug; use debug; with parameters; use parameters; with parameters.extended; use parameters.extended; use parameters.framework_parameters_table_package; with call_framework; use call_framework; with call_framework_interface; use call_framework_interface; use call_framework_interface.framework_response_package; use call_framework_interface.framework_request_package; with call_scheduling_framework; use call_scheduling_framework; procedure cheddarlite is procedure usage is begin Put_Line ("Usage : cheddarlite [switches]"); New_Line; Put_Line ("Switches :"); Put_Line (" -help : this help."); Put_Line (" -debug : activate debug mode."); Put_Line (" -file filename : specify AADL or XML project filename."); Put_Line (" -request requesttype : request a service requesttype to cheddar kernel."); Put_Line (" * bt or basictests : basic feasibility tests."); Put_Line (" * st or schedulingtests : scheduling feasibility tests."); Put_Line (" * cp or computepriority : compute priority for RM and DM schedulers."); Put_Line (" * all : all requests."); OS_Exit (0); end usage; procedure run_basic_feasibility_tests (a_sys : in out system) is response_list : framework_response_table; request_list : framework_request_table; a_request : framework_request; begin initialize (response_list); initialize (request_list); initialize (a_request); a_request.statement := scheduling_feasibility_basics; add (request_list, a_request); sequential_framework_request (a_sys, request_list, response_list, total_order, string_output); for j in 0 .. response_list.nb_entries - 1 loop Put_Line (To_String (response_list.entries (j).title)); Put_Line (To_String (response_list.entries (j).text)); end loop; end run_basic_feasibility_tests; procedure compute_scheduling (a_sys : in out system) is response_list : framework_response_table; request_list : framework_request_table; a_request : framework_request; a_param : parameter_ptr; begin initialize (response_list); initialize (request_list); initialize (a_request); a_request.statement := scheduling_simulation_time_line; a_param := new parameters.parameter (integer_parameter); a_param.parameter_name := To_Unbounded_String ("period"); a_param.integer_value := 100; add (a_request.param, a_param); a_param := new parameters.parameter (boolean_parameter); a_param.parameter_name := To_Unbounded_String ("schedule_with_offsets"); a_param.boolean_value := True; add (a_request.param, a_param); a_param := new parameters.parameter (boolean_parameter); a_param.parameter_name := To_Unbounded_String ("schedule_with_precedencies"); a_param.boolean_value := True; add (a_request.param, a_param); a_param := new parameters.parameter (boolean_parameter); a_param.parameter_name := To_Unbounded_String ("schedule_with_resources"); a_param.boolean_value := True; add (a_request.param, a_param); a_param := new parameters.parameter (integer_parameter); a_param.parameter_name := To_Unbounded_String ("seed_value"); a_param.integer_value := 0; add (a_request.param, a_param); add (request_list, a_request); sequential_framework_request (a_sys, request_list, response_list); for j in 0 .. response_list.nb_entries - 1 loop Put_Line (To_String (response_list.entries (j).title)); Put_Line (To_String (response_list.entries (j).text)); end loop; end compute_scheduling; procedure call_processor_analysis (a_sys : in out system; name : in Unbounded_String) is response_list : framework_response_table; request_list : framework_request_table; a_request : framework_request; a_param : parameter_ptr; begin initialize (response_list); initialize (request_list); initialize (a_request); a_request.target := name; a_request.statement := scheduling_simulation_preemption_number; add (request_list, a_request); initialize (a_request); a_request.target := name; a_request.statement := scheduling_simulation_context_switch_number; add (request_list, a_request); initialize (a_request); a_param := new parameters.parameter (boolean_parameter); a_param.parameter_name := To_Unbounded_String ("worst_case"); a_param.boolean_value := True; add (a_request.param, a_param); a_param := new parameters.parameter (boolean_parameter); a_param.parameter_name := To_Unbounded_String ("best_case"); a_param.boolean_value := True; add (a_request.param, a_param); a_param := new parameters.parameter (boolean_parameter); a_param.parameter_name := To_Unbounded_String ("average_case"); a_param.boolean_value := True; add (a_request.param, a_param); a_request.target := name; a_request.statement := scheduling_simulation_response_time; add (request_list, a_request); sequential_framework_request (a_sys, request_list, response_list); for j in 0 .. response_list.nb_entries - 1 loop Put_Line (To_String (response_list.entries (j).title)); Put_Line (To_String (response_list.entries (j).text)); end loop; end call_processor_analysis; procedure compute_priority (a_sys : in out system) is priority_list : framework_response_table; request_list : framework_request_table; a_request : framework_request; begin initialize (priority_list); initialize (request_list); initialize (a_request); a_request.statement := scheduling_set_priorities_according_to_rate_monotonic; add (request_list, a_request); a_request.statement := scheduling_set_priorities_according_to_deadline_monotonic; add (request_list, a_request); sequential_framework_request (a_sys, request_list, priority_list); for j in 0 .. priority_list.nb_entries - 1 loop Put_Line (To_String (priority_list.entries (j).title)); Put_Line (To_String (priority_list.entries (j).text)); end loop; end compute_priority; -- command line arguments --Project_File_Name : Unbounded_String := To_Unbounded_String(""); project_file_name : unbounded_string_ptr; aadl_project_file_name : unbounded_string_list; cmd : Command_Line; iter : Command_Line_Iterator; extension : Unbounded_String := To_Unbounded_String (""); slices : GNAT.String_Split.Slice_Set; -- exception project_component_type : Unbounded_String := To_Unbounded_String (""); -- tests sys : system; project_file_list : unbounded_string_list; project_file_dir_list : unbounded_string_list; basic_feasibility_tests_request : Boolean := False; scheduling_tests_request : Boolean := False; compute_priority_request : Boolean := False; a_processor : generic_processor_ptr; my_processor_iterator : processors_iterator; begin -- initialization project_file_name := new Unbounded_String; project_file_name.all := To_Unbounded_String (""); cheddar_debug := no_debug; -- Get arguments while Getopt ("request: file: help debug") /= ASCII.NUL loop Add_Switch (cmd, Full_Switch, GNAT.Command_Line.Parameter); end loop; Start (cmd, iter, Expanded => True); if Has_More (iter) = False then usage; end if; while Has_More (iter) loop --Put_Line("current switch : " & To_String --(To_Unbounded_String(Current_Switch(Iter)))); if Current_Switch (iter) = "debug" then cheddar_debug := verbose; elsif Current_Switch (iter) = "help" then usage; elsif Current_Switch (iter) = "file" then if Current_Parameter (iter) = "" then usage; else --Project_File_Name := To_Unbounded_String(Current_Parameter --(Iter)); project_file_name.all := To_Unbounded_String (Current_Parameter (iter)); add (aadl_project_file_name, project_file_name); GNAT.String_Split.Create (slices, Current_Parameter (iter), "."); extension := To_Unbounded_String (GNAT.String_Split.Slice (slices, GNAT.String_Split.Slice_Count (slices))); end if; elsif Current_Switch (iter) = "request" then if ((Current_Parameter (iter) = "basictests") or (Current_Parameter (iter) = "bt")) then basic_feasibility_tests_request := True; elsif ((Current_Parameter (iter) = "schedulingtests") or (Current_Parameter (iter) = "st")) then scheduling_tests_request := True; elsif ((Current_Parameter (iter) = "computepriority") or (Current_Parameter (iter) = "cp")) then compute_priority_request := True; elsif Current_Parameter (iter) = "all" then basic_feasibility_tests_request := True; scheduling_tests_request := True; compute_priority_request := True; else usage; end if; end if; Next (iter); end loop; -- Framework Request -- Read project file initialize (project_file_list); if extension = "xml" then call_framework.initialize (False); systems.read_from_xml_file (sys, project_file_dir_list, project_file_name.all); elsif extension = "aadl" then call_framework.initialize (True); systems.read_from_aadl_file (sys, project_file_dir_list, aadl_project_file_name); else usage; end if; -- Compute basic feasibility tests if basic_feasibility_tests_request then run_basic_feasibility_tests (sys); end if; -- Compute the scheduling if scheduling_tests_request then compute_scheduling (sys); -- Perform analysis on the computed scheduling for each processor reset_iterator (sys.processors, my_processor_iterator); loop current_element (sys.processors, a_processor, my_processor_iterator); call_processor_analysis (sys, a_processor.name); exit when is_last_element (sys.processors, my_processor_iterator); next_element (sys.processors, my_processor_iterator); end loop; end if; if compute_priority_request then compute_priority (sys); end if; exception -- invalid command line argument -- when GNAT.Command_Line.Invalid_Switch => begin --Put_Line ("Invalid Switch : " & Full_Switch); usage; end; when GNAT.Command_Line.Invalid_Parameter => begin --Put_Line("Missing parameter for switch : " & Full_Switch); usage; end; when task_set.invalid_parameter => if (extension = "aadl") then project_component_type := To_Unbounded_String ("thread component"); else project_component_type := To_Unbounded_String ("task"); end if; Put_Line ("Invalid " & To_String (project_component_type) & " argument : " & Exception_Message); when address_space_set.invalid_parameter => if (extension = "aadl") then project_component_type := To_Unbounded_String ("process component"); else project_component_type := To_Unbounded_String ("address space"); end if; Put_Line ("Invalid " & To_String (project_component_type) & " argument : " & Exception_Message); when processor_set.invalid_parameter => if (extension = "aadl") then project_component_type := To_Unbounded_String ("processor component"); else project_component_type := To_Unbounded_String ("processor"); end if; Put_Line ("Invalid " & To_String (project_component_type) & " argument : " & Exception_Message); when buffer_set.invalid_parameter => if (extension = "aadl") then project_component_type := To_Unbounded_String ("event data port component"); else project_component_type := To_Unbounded_String ("buffer"); end if; Put_Line ("Invalid " & To_String (project_component_type) & " argument : " & Exception_Message); when resource_set.invalid_parameter => if (extension = "aadl") then project_component_type := To_Unbounded_String ("data component"); else project_component_type := To_Unbounded_String ("resource"); end if; Put_Line ("Invalid " & To_String (project_component_type) & " argument : " & Exception_Message); when xml_read_error => Put_Line ("Can not read project XML file : " & Exception_Message); when aadl_read_error => Put_Line ("Can not read project AADL files : " & Exception_Message); when Ada.IO_Exceptions.Name_Error => Put_Line ("Can not open project files : name error"); when Ada.IO_Exceptions.Status_Error => Put_Line ("Can not open project files : status error"); when Ada.IO_Exceptions.Mode_Error => Put_Line ("Can not open project files : mode error"); when Ada.IO_Exceptions.Use_Error => Put_Line ("Can not open project files : use error"); when Ada.IO_Exceptions.Device_Error => Put_Line ("Can not open project files : device error"); when Ada.IO_Exceptions.End_Error => Put_Line ("Can not open project files : end error"); when Ada.IO_Exceptions.Data_Error => Put_Line ("Can not open project files : data error"); when Ada.IO_Exceptions.Layout_Error => Put_Line ("Can not open project files : layout error"); when others => Put_Line ("This is an internal Cheddar bug ... sorry"); Put_Line ("WARNING : your project was saved in the file cheddar_bug.xml"); Put_Line ("Exception name : " & Exception_Name); Put_Line ("Exception message : " & Exception_Message); systems.write_to_xml_file (sys, To_Unbounded_String ("cheddar_bug.xml")); -- Put_Line("Please, send a bug report to cheddar@listes.univ-brest.fr"); -- Put_Line("Do not forget to join your AADL/XML Cheddar project files --with your bug report"); end cheddarlite;