------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ 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;