------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 initialize_framework; use initialize_framework; with Scheduler_Interface; use Scheduler_Interface; with v2_Xml_Parsers; with Xml_generic_Parsers; with Xml_generic_Parsers.architecture; with Offsets; use Offsets; with integer_util; use integer_util; with Tasks; use Tasks; use Tasks.Generic_Task_List_Package; with buffers; use buffers; use buffers.Buffer_Roles_Package; with resources; use resources; use resources.Resource_Accesses; with processor_interface; use processor_interface; with translate; use translate; with framework_config; use framework_config; with GNAT.Current_Exception; use GNAT.Current_Exception; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with unbounded_strings; use unbounded_strings; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Unicode.CES; use Unicode.CES; with Unicode.Encodings; use Unicode.Encodings; with Ada.Direct_IO; with Ada.Exceptions; use Ada.Exceptions; with Ada.IO_Exceptions; use Ada.IO_Exceptions; with Ada.Text_IO; use Ada.Text_IO; with Ada.Text_IO.Text_Streams; use Ada.Text_IO.Text_Streams; with Ada.Unchecked_Deallocation; with DOM.Core.Documents; use DOM.Core, DOM.Core.Documents; with DOM.core; use DOM.core; with DOM.Core.Nodes; use DOM.Core.Nodes; with DOM.Readers; use DOM.Readers; with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.Expect; use GNAT.Expect; with GNAT.OS_Lib; use GNAT.OS_Lib; with Input_Sources.File; use Input_Sources.File; with Input_Sources.Http; use Input_Sources.Http; with Input_Sources; use Input_Sources; with Sax.Encodings; use Sax.Encodings; with Sax.Readers; use Sax.Readers; with Sax.Utils; use Sax.Utils; with Sax.Symbols; package body Systems is procedure Check_hierarchical_schedulers (A_Sys : in System; a_addr_name : unbounded_string; a_processor_name : unbounded_string; a_scheduler_type : schedulers_type) is a_processor : generic_processor_ptr; begin if (a_scheduler_type /= no_scheduling_protocol) then -- Address spaces cannot have scheduler if processors has no -- hierchical scheduling policy -- A_processor:=Search_processor(a_sys.processors, a_processor_name); if (a_processor.processor_type/=monocore_type) then Raise_Exception (Invalid_Parameter'Identity, To_String ( a_addr_name & "/" & a_processor.name & " : " & Lb_hierarchical_not_allowed(Current_Language) )); else if (mono_core_processor_ptr(a_processor).core.scheduling.scheduler_type /= Hierarchical_Cyclic_Protocol) and (mono_core_processor_ptr(a_processor).core.scheduling.scheduler_type /= Hierarchical_Round_Robin_Protocol) and (mono_core_processor_ptr(a_processor).core.scheduling.scheduler_type /= Hierarchical_Fixed_Priority_Protocol) and (mono_core_processor_ptr(a_processor).core.scheduling.scheduler_type /= Hierarchical_Offline_Protocol) then Raise_Exception (Invalid_Parameter'Identity, To_String ( a_addr_name & "/" & a_processor.name & " : " & Lb_hierarchical_not_allowed(Current_Language) )); end if; end if; end if; end Check_hierarchical_schedulers; procedure Check_entity_location (A_Sys : in System; a_entity_name : unbounded_string; a_processor_name : unbounded_string; a_addr_name : unbounded_string) is a_processor : generic_processor_ptr; a_address_space : address_space_ptr; begin -- Check that entities exist -- A_Processor:=Search_Processor(a_sys.processors, a_processor_name); A_Address_Space:=Search_Address_Space(a_sys.address_spaces, a_addr_name); -- Check that both address space and task are located on the same cpu -- if a_address_space.cpu_name/=a_processor_name then Raise_Exception (Invalid_Parameter'Identity, To_String ( a_entity_Name & " : " & a_addr_name & "/" & a_processor_name & Lb_are_unconsistent(Current_Language) )); end if; end check_entity_location; -- For a task who has an affinity on a core, verify that migration -- are forbidden on the associated processor -- procedure Check_task_affinity (A_Sys : in System; a_task_name : unbounded_string; a_processor_name : unbounded_string; a_core_name : unbounded_string) is a_processor : generic_processor_ptr; begin a_processor:=Search_Processor(a_sys.processors, a_processor_name); if (a_core_name/=empty_string) and (a_processor.processor_type=Monocore_type) then Raise_Exception (Invalid_Parameter'Identity, To_String (a_task_name & "/" & a_processor_name & " : Task/core affinity cannot be used with monoprocessor" )); end if; if (a_core_name/=empty_string) and (a_processor.migration_type/=No_Migration_Type) then Raise_Exception (Invalid_Parameter'Identity, To_String (a_task_name & "/" & a_processor_name & " : Task/core affinity cannot be used when processor can do migration" )); end if; if (a_core_name=empty_string) and (a_processor.migration_type=No_Migration_Type) and (a_processor.processor_type/=Monocore_type) then Raise_Exception (Invalid_Parameter'Identity, To_String (a_task_name & "/" & a_processor_name & " : Task/core affinity mandatory with this processor (multiprocessor without migration)" )); end if; end Check_task_affinity; procedure Check_Entity_Referencing_a_task (A_Sys : in System; A_Task : Generic_Task_Ptr) is begin Check_entity_referencing_Task (A_Sys.Resources, A_Task.name); Check_entity_referencing_Task (A_Sys.Buffers, A_Task.name); Check_entity_referencing_Task (A_Sys.task_groups, A_Task.name); Check_entity_referencing_Task (A_Sys.Dependencies, A_Task.name); end Check_Entity_Referencing_a_task; procedure Check_Entity_Referencing_a_buffer (A_Sys : in System; A_Buffer : Buffer_Ptr) is begin Check_entity_referencing_buffer(A_Sys.Dependencies, A_Buffer.name); end Check_Entity_Referencing_a_buffer; procedure Check_Entity_Referencing_a_resource (A_Sys : in System; A_resource : generic_resource_Ptr) is begin Check_entity_referencing_resource(A_Sys.Dependencies, A_resource.name); end Check_Entity_Referencing_a_resource; procedure Check_Entity_Referencing_a_message (A_Sys : in System; A_Message : Generic_Message_Ptr) is begin Check_entity_referencing_message(A_Sys.Dependencies, A_Message.name); end Check_Entity_Referencing_a_message; procedure Check_Entity_Referencing_a_processor (A_Sys : in System; A_Processor : Generic_Processor_Ptr) is begin Check_entity_referencing_Processor (A_Sys.Dependencies, A_Processor.name); Check_entity_referencing_Processor (A_Sys.Resources, A_Processor.name); Check_entity_referencing_Processor (A_Sys.Buffers, A_Processor.name); Check_entity_referencing_Processor (A_Sys.Tasks, A_Processor.name); Check_entity_referencing_Processor (A_Sys.Address_Spaces, A_Processor.name); end Check_Entity_Referencing_a_processor; procedure Check_Entity_Referencing_a_core_unit (A_Sys : in System; A_core_unit : Core_Unit_Ptr) is begin Check_entity_referencing_core_unit (A_Sys.processors, A_core_unit); end Check_Entity_Referencing_a_core_unit; procedure Check_Entity_Referencing_a_network (A_Sys : in System; A_network : generic_network_ptr) is begin null; end Check_Entity_Referencing_a_network; procedure Check_Entity_Referencing_a_deployment(A_Sys : in System; A_deployment : generic_deployment_ptr) is begin null; end Check_Entity_Referencing_a_deployment; procedure Check_Entity_Referencing_an_Address_Space (A_Sys : in System; An_Address_Space : Address_Space_Ptr) is begin Check_entity_referencing_Address_Space (A_Sys.Resources, An_Address_Space.name); Check_entity_referencing_Address_Space (A_Sys.Buffers, An_Address_Space.name); Check_entity_referencing_Address_Space (A_Sys.Tasks, An_Address_Space.name); end Check_Entity_Referencing_an_Address_Space; procedure Check_Entity_Referencing_a_cache (A_Sys : in System; A_Cache : Generic_Cache_Ptr) is begin Check_entity_referencing_cache (A_Sys.processors, A_cache); end Check_Entity_Referencing_a_cache; procedure Check_Entity_Referencing_a_task_group (A_Sys : in System; A_Task_Group : Generic_Task_Group_Ptr) is begin null; end Check_Entity_Referencing_a_task_group; procedure Delete_Task (A_Sys : in out System; A_Task : Generic_Task_Ptr) is begin Delete_Task (A_Sys.Resources, A_Task.name); Delete_Task (A_Sys.Buffers, A_Task.name); Delete_All_Task_Dependencies (A_Sys.Dependencies, A_Task); delete (A_Sys.Tasks, A_Task); end Delete_Task; procedure Delete_Task_Group (A_Sys : in out System; A_Task_Group : Generic_Task_Group_Ptr; Delete_All_Entities : Boolean := true) is A_Task : Generic_Task_Ptr; Searched_Task : Generic_Task_Ptr; Task_List_Iterator : Generic_Task_Iterator; begin if (not is_empty(A_Task_Group.task_list)) then reset_head_iterator (A_Task_Group.task_list, Task_List_Iterator); loop current_element (A_Task_Group.task_list, A_Task, Task_List_Iterator); -- Remove this and replace below parameters with A_Task, when deep_copy is implemented Searched_Task := Search_Task(A_Sys.Tasks, A_Task.name); if (Delete_All_Entities) then delete_task(A_Sys, Searched_Task); else delete(A_Sys.Tasks, Searched_Task); end if; if is_tail_element (A_Task_Group.task_list, Task_List_Iterator) then exit; end if; next_element (A_Task_Group.task_list, Task_List_Iterator); end loop; end if; delete (A_Sys.Task_Groups, A_Task_Group); end Delete_Task_Group; procedure Duplicate (Src : in System; Dest : in out System) is begin duplicate (Src.Tasks, Dest.Tasks); duplicate (Src.Task_Groups, Dest.Task_Groups); duplicate (Src.Resources, Dest.Resources); duplicate (Src.Messages, Dest.Messages); duplicate (Src.Dependencies, Dest.Dependencies); duplicate (Src.Core_units, Dest.Core_units); duplicate (Src.Processors, Dest.Processors); duplicate (Src.Buffers, Dest.Buffers); duplicate (Src.Networks, Dest.Networks); duplicate (Src.Event_Analyzers, Dest.Event_Analyzers); duplicate (Src.Address_Spaces, Dest.Address_Spaces); duplicate (Src.deployments, Dest.deployments); duplicate (Src.Cache_Blocks, Dest.Cache_Blocks); duplicate (Src.Caches, Dest.Caches); duplicate (Src.CFGs, Dest.CFGs); duplicate (Src.CFG_Nodes, Dest.CFG_Nodes); duplicate (Src.CFG_Edges, Dest.CFG_Edges); duplicate (Src.Cache_Access_Profiles, Dest.Cache_Access_Profiles); duplicate (Src.memories, Dest.memories); end Duplicate; function XML_String (obj : in System; level : in Natural := 0) return Unbounded_String is result : Unbounded_String := empty_string; begin result := result & "" ; if not is_empty (obj.Cache_Blocks) then result := result & ""; result := result & XML_root_String (obj.Cache_Blocks); result := result & ""; end if; if not is_empty (obj.Caches) then result := result & ""; result := result & XML_root_String (obj.Caches); result := result & ""; end if; if not is_empty (obj.CFG_Nodes) then result := result & ""; result := result & XML_root_String (obj.CFG_Nodes); result := result & ""; end if; if not is_empty (obj.CFG_Edges) then result := result & ""; result := result & XML_root_String (obj.CFG_Edges); result := result & ""; end if; if not is_empty (obj.CFGs) then result := result & ""; result := result & XML_root_String (obj.CFGs); result := result & ""; end if; if not is_empty (obj.Cache_Access_Profiles) then result := result & ""; result := result & XML_root_String (obj.Cache_Access_Profiles); result := result & ""; end if; if not is_empty (obj.memories) then result := result & ""; result := result & xml_root_string (obj.memories); result := result & ""; end if; if not is_empty (obj.Core_units) then result := result & ""; result := result & xml_root_string (obj.Core_units); result := result & ""; end if; if not is_empty (obj.Processors) then result := result & ""; result := result & xml_root_string (obj.Processors); result := result & ""; end if; if not is_empty (obj.Networks) then result := result & ""; result := result & xml_root_string (obj.Networks); result := result & ""; end if; if not is_empty (obj.Address_Spaces) then result := result & ""; result := result & xml_root_string (obj.Address_Spaces); result := result & ""; end if; if not is_empty (obj.Tasks) then result := result & ""; result := result & xml_root_string (obj.Tasks); result := result & ""; end if; if not is_empty (obj.Task_Groups) then result := result & ""; result := result & xml_root_string (obj.Task_Groups); result := result & ""; end if; if not is_empty (obj.Resources) then result := result & ""; result := result & xml_root_string (obj.Resources); result := result & ""; end if; if not is_empty (obj.Messages) then result := result & ""; result := result & xml_root_string (obj.Messages); result := result & ""; end if; if not is_empty (obj.Buffers) then result := result & ""; result := result & xml_root_string (obj.Buffers); result := result & ""; end if; if not is_empty (obj.Event_Analyzers) then result := result & ""; result := result & xml_root_string (obj.Event_Analyzers); result := result & ""; end if; if not is_empty (obj.batteries) then result := result & ""; result := result & xml_root_string (obj.batteries); result := result & ""; end if; if obj.dependencies/=null then if not is_empty (obj.Dependencies.Depends) then result := result & ""; result := result & XML_root_String (obj.Dependencies); result := result & ""; end if; end if; if not is_empty (obj.deployments) then result := result & ""; result := result & XML_root_String (obj.deployments); result := result & ""; end if; if not is_empty (obj.scheduling_errors) then result := result & ""; result := result & XML_root_String (obj.scheduling_errors); result := result & ""; end if; result := result & ""; return result; end XML_String; function XML_String (obj : in System_Ptr; level : in Natural := 0) return Unbounded_String is begin return XML_String (obj.all, level); end XML_String; procedure Put_Xml (A_System : in System) is begin Put (To_String (XML_String (A_System))); end Put_Xml; procedure Put_Aadl (A_System : in System) is begin New_Line; -- Export AADL standard properties and Cheddar's properties -- -- Put_Line(To_String(Export_Aadl_Standard_Properties(A_System))); -- Put_Line(To_String(Export_Aadl_Project_Properties(A_System))); -- Put_Line(To_String(Export_Aadl_Cheddar_Properties(A_System))); -- Export the system itself -- Put_Line (To_String (Export_Aadl_Implementations (A_System))); New_Line; end Put_Aadl; procedure Put (A_System : in System) is begin Put_Line ("***** LIST OF PROCESSORS *****"); put (A_System.Processors); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF TASKS *****"); put (A_System.Tasks); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF TASK GROUPS *****"); put (A_System.Task_Groups); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF RESSOURCES *****"); put (A_System.Resources); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF BUFFERS *****"); put (A_System.Buffers); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF MESSAGES *****"); put (A_System.Messages); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF DEPENCENCIES *****"); Put (A_System.Dependencies); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF NETWORKS *****"); put (A_System.Networks); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF EVENTS ANALYZERS *****"); put (A_System.Event_Analyzers); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF ADDRESS SPACES *****"); put (A_System.Address_Spaces); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF CACHE BLOCKS *****"); put (A_System.Cache_Blocks); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF CACHES *****"); put (A_System.Caches); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF CFGs *****"); put (A_System.CFGs); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF CFG_Nodes *****"); put (A_System.CFG_Nodes); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF CFG_Edges *****"); put (A_System.CFG_Edges); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF Cache_Access_Profiles *****"); put (A_System.Cache_Access_Profiles); New_Line; New_Line; New_Line; Put_Line ("***** LIST OF Memories *****"); put (A_System.Memories); New_Line; New_Line; New_Line; end Put; procedure Put (A_System : in System_Ptr) is begin Put (A_System.all); end Put; ------------------------------------------------ procedure Initialize (A_System : in out System) is begin check_initialize; reset (A_System.Networks); reset (A_System.Tasks); reset (A_System.Task_Groups); reset (A_System.Messages); reset (A_System.Resources); if A_System.Dependencies /= null then Free (A_System.Dependencies); end if; A_System.Dependencies := new Tasks_Dependencies; Reset (A_System.Dependencies); reset (A_System.Buffers); reset (A_System.Processors); reset (A_System.Memories); reset (A_System.core_units); reset (A_System.Event_Analyzers); reset (A_System.Address_Spaces); reset (A_System.Caches); reset (A_System.deployments); reset (A_System.Cache_Blocks); reset (A_System.Caches); reset (A_System.CFGs); reset (A_System.CFG_Nodes); reset (A_System.CFG_Edges); end Initialize; procedure Initialize (A_System : in System_Ptr) is begin Initialize (A_System.all); end Initialize; procedure Read_From_Xml_File (A_System : in out System; File_Name : in String; Validation : in Boolean := True) is Dir_List : unbounded_string_list; begin initialize(Dir_List); Read_From_Xml_File (A_System, Dir_List, To_Unbounded_String (File_Name), Validation); end Read_From_Xml_File; procedure Read_From_Xml_File (A_System : in out System; Dir_List : in unbounded_string_list; File_Name : in String; Validation : in Boolean := True) is begin Read_From_Xml_File (A_System, Dir_List, To_Unbounded_String (File_Name), Validation); end Read_From_Xml_File; procedure Read_From_v2_Xml_File (A_System : in out System; Dir_List : in unbounded_string_list; File_Name : in String; Validation : in Boolean := True) is begin Read_From_v2_Xml_File (A_System, Dir_List, To_Unbounded_String (File_Name), Validation); end Read_From_v2_Xml_File; procedure Read_From_v2_Xml_File (A_System : in out System; Dir_List : in unbounded_string_list; File_Name : in Unbounded_String; Validation : in Boolean := True) is use v2_Xml_Parsers; Read : File_Input; My_Reader : v2_xml_parsers.Xml_project_Parser; Name_Start : Natural; S : constant String := To_String (File_Name); begin -- Base file name should be used as the public Id -- Name_Start := S'Last; while Name_Start >= S'First and then S (Name_Start) /= '/' loop Name_Start := Name_Start - 1; end loop; Set_Public_Id (Read, S (Name_Start + 1 .. S'Last)); Set_System_Id (Read, S); Open (S, Read); -- xmlns:* attributes will be reported in Start_Element -- Set_Feature (My_Reader, Namespace_Prefixes_Feature, False); Set_Feature (My_Reader, Validation_Feature, Validation); Parse (My_Reader, Read); A_System := Get_Parsed_System (My_Reader); Close (Read); exception when XML_Fatal_Error => Close (Read); raise Xml_Read_Error; end Read_From_v2_Xml_File; procedure Read_From_Xml_File (A_System : in out System; Dir_List : in unbounded_string_list; File_Name : in Unbounded_String; Validation : in Boolean := True) is use Xml_generic_Parsers; use Xml_generic_Parsers.architecture; Read : File_Input; My_Reader : Xml_architecture_Parser; Name_Start : Natural; S : constant String := To_String (File_Name); begin -- Base file name should be used as the public Id -- Name_Start := S'Last; while Name_Start >= S'First and then S (Name_Start) /= '/' loop Name_Start := Name_Start - 1; end loop; Set_Public_Id (Read, S (Name_Start + 1 .. S'Last)); Set_System_Id (Read, S); Open (S, Read); -- xmlns:* attributes will be reported in Start_Element -- Set_Feature (My_Reader, Namespace_Prefixes_Feature, False); Set_Feature (My_Reader, Validation_Feature, Validation); Parse (My_Reader, Read); A_System := Get_Parsed_System (My_Reader); Close (Read); exception when XML_Fatal_Error => Close (Read); raise Xml_Read_Error; end Read_From_Xml_File; procedure Write_To_Xml_File (A_System : in System; File_Name : in String) is begin Write_To_Xml_File (A_System, To_Unbounded_String (File_Name)); end Write_To_Xml_File; procedure Write_To_Xml_File (A_System : in System; File_Name : in Unbounded_String) is Input : File_Input; Reader : Tree_Reader; d : Document; Into : File_Type; begin -- Open file and Write XML Header -- Create (Into, Mode => Out_File, Name => To_String (File_Name)); Put_Line (Into, " "); -- Put_Line (Into, ""); -- Put_Line (Into, ""); New_Line (Into, 2); Put (Into, To_String (Xml_string (A_System))); Close (Into); Open (to_string(file_name), Input); Parse (Reader, Input); d:=Get_Tree(Reader); Close (Input); Create (Into, Mode => Out_File, Name => To_String (File_Name)); Write (Stream => Stream (into), N => d, Print_Comments => false, Print_XML_Declaration => true, With_URI => false, EOL_Sequence => "" & ASCII.LF, Pretty_Print => true, Encoding => Unicode.Encodings.Get_By_Name ("utf-8"), Collapse_Empty_Nodes => false); Free (Reader); Close (into); end Write_To_Xml_File; procedure Read_From_Aadl_File (A_System : in out System; Dir_List : in unbounded_string_list; Project_File_List : in unbounded_string_list) is begin -- remove the aadl parser for cheddar kernel null; end Read_From_Aadl_File; procedure Write_To_Aadl_File (A_System : in System; File_Name : in Unbounded_String) is Into : File_Type; begin -- Open file and Write aadl specification -- Create (Into, Mode => Out_File, Name => To_String (File_Name)); New_Line (Into); -- Export AADL standard customized properties -- -- Put_Line(Into, To_String(Export_Aadl_Standard_Properties(A_System))); -- Put_Line(Into, To_String(Export_Aadl_Project_Properties(A_System))); -- Put_Line(Into, To_String(Export_Aadl_Cheddar_Properties(A_System))); -- Export the system itself -- Put_Line (Into, To_String (Export_Aadl_Implementations (A_System))); New_Line (Into); Close (Into); end Write_To_Aadl_File; procedure Write_Aadl_Standard_Properties_Set_To_File (A_System : in System) is Into : File_Type; begin -- Open file and Write aadl specification -- Create (Into, Mode => Out_File, Name => "AADL_Properties.aadl"); New_Line (Into); Put_Line (Into, To_String (Export_Aadl_Standard_Properties (A_System))); New_Line (Into); Close (Into); end Write_Aadl_Standard_Properties_Set_To_File; procedure Write_Cheddar_Property_Sets_To_File (A_System : in System) is Into : File_Type; begin -- Open file and Write aadl specification -- Create (Into, Mode => Out_File, Name => "AADL_Project.aadl"); New_Line (Into); Put_Line (Into, To_String (Export_Aadl_Project_Properties (A_System))); New_Line (Into); Close (Into); Create (Into, Mode => Out_File, Name => "Cheddar_Properties.aadl"); New_Line (Into); Put_Line (Into, To_String (Export_Aadl_Cheddar_Properties (A_System))); New_Line (Into); Close (Into); Create (Into, Mode => Out_File, Name => "User_Defined_Cheddar_Properties.aadl"); New_Line (Into); Put_Line (Into, To_String (Export_Aadl_User_Defined_Cheddar_Properties (A_System))); New_Line (Into); Close (Into); end Write_Cheddar_Property_Sets_To_File; ------------------------------------------------ function Export_Aadl_User_Defined_Cheddar_Properties (A_System : in System) return Unbounded_String is Result : Unbounded_String := empty_string; Tmp : Unbounded_String := empty_string; begin -- Export user's defined properties -- Tmp := Export_Aadl_User_Defined_Properties (A_System.Tasks); Tmp := Tmp & Export_Aadl_User_Defined_Properties (A_System.Messages); Result := Result & To_Unbounded_String ("property set User_Defined_Cheddar_Properties is") & unbounded_lf & unbounded_lf; if Tmp = empty_string then Result := Result & "Dummy_User_Defined_Cheddar_Properties : aadlboolean" & unbounded_lf & "applies to (thread, thread group);"; else Result := Result & Tmp; end if; Result := Result & unbounded_lf & To_Unbounded_String ("end User_Defined_Cheddar_Properties;") & unbounded_lf & unbounded_lf; return Result; end Export_Aadl_User_Defined_Cheddar_Properties; function Export_Aadl_Standard_Properties (A_System : in System) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := Result & ASCII.LF & To_Unbounded_String( " --****************************************************** "); Result := Result & ASCII.LF & To_Unbounded_String (" -- AADL Standard AADL_V1.0 "); Result := Result & ASCII.LF & To_Unbounded_String (" -- Appendix A (normative) "); Result := Result & ASCII.LF & To_Unbounded_String (" -- Predeclared Property Sets "); Result := Result & ASCII.LF & To_Unbounded_String (" -- 03Nov04 "); Result := Result & ASCII.LF & To_Unbounded_String (" -- Update to reflect current standard on 28Mar06 "); Result := Result & ASCII.LF & To_Unbounded_String( " --****************************************************** "); Result := Result & ASCII.LF & To_Unbounded_String (" property set AADL_Properties is "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Activate_Deadline: Time applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Activate_Execution_Time: Time_Range applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Activate_Entrypoint: aadlstring applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Active_Thread_Handling_Protocol: inherit Supported_Active_Thread_Handling_Protocols => value(Default_Active_Thread_Handling_Protocol) applies to (thread, thread group, process, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Active_Thread_Queue_Handling_Protocol: inherit enumeration (flush, hold) => flush applies to (thread, thread group, process, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Actual_Connection_binding: inherit list of reference (bus, processor, device) applies to (port connections, thread, thread group, process, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Actual_Latency: Time applies to (flow); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Actual_Memory_binding: inherit reference (memory) applies to (thread, thread group, process, system, processor, data port, event data port, subprogram); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Actual_Processor_binding: inherit reference (processor) applies to (thread, thread group, process, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Actual_Subprogram_Call: reference (server subprogram) applies to (subprogram); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Actual_Subprogram_Call_binding: inherit list of reference (bus, processor, memory, device) applies to (subprogram); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Actual_Throughput: Data_Volume applies to (flow); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Aggregate_Data_Port: aadlboolean => false applies to (port group); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Access_Protocol: list of enumeration (Memory_Access, Device_Access) applies to (bus); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Connection_binding: inherit list of reference (bus, processor, device) applies to (port connections, thread group, process, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Connection_binding_Class: inherit list of classifier (processor, bus, device) applies to (port connections, thread, thread group, process, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Connection_Protocol: list of enumeration (Data_Connection, Event_Connection, Event_Data_Connection, Data_Access_Connection, Server_Subprogram_Call) applies to (bus, device); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Dispatch_Protocol: list of Supported_Dispatch_Protocols applies to (processor); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Memory_binding: inherit list of reference (memory, system, processor) applies to (thread, thread group, process, system, device, data port, event data port, subprogram, processor); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Memory_binding_Class: inherit list of classifier (memory, system, processor) applies to (thread, thread group, process, system, device, data port, event data port, subprogram, processor); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Allowed_Message_Size: Size_Range applies to (bus); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Period: list of Time_Range applies to (processor, system); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Processor_binding: inherit list of reference (processor, system) applies to (thread, thread group, process, system, device); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Processor_binding_Class: inherit list of classifier (processor, system) applies to (thread, thread group, process, system, device); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Subprogram_Call: list of reference (server subprogram) applies to (subprogram); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Allowed_Subprogram_Call_binding: inherit list of reference (bus, processor, device) applies to (subprogram, thread, thread group, process, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Assign_Time: Time applies to (processor, bus); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Assign_Byte_Time: Time applies to (processor, bus); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Assign_Fixed_Time: Time applies to (processor, bus); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Available_Memory_binding: inherit list of reference (memory, system) applies to (system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Available_Processor_binding: inherit list of reference (processor, system) applies to (system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Base_Address: access aadlinteger 0 .. value(Max_Base_Address) applies to (memory); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Client_Subprogram_Execution_Time: Time applies to (subprogram); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Clock_Jitter: Time applies to (processor, system); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Clock_Period: Time applies to (processor, system); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Clock_Period_Range: Time_Range applies to (processor, system); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Compute_Deadline: Time applies to (thread, device, subprogram, event port, event data port); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Compute_Entrypoint: aadlstring applies to (thread, subprogram, event port, event data port); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Compute_Execution_Time: Time_Range applies to (thread, device, subprogram, event port, event data port); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Concurrency_Control_Protocol: Supported_Concurrency_Control_Protocols => NoneSpecified applies to (data); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Connection_Protocol: Supported_Connection_Protocols applies to (connections); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Data_Volume: type aadlinteger 0 bitsps .. value(Max_Aadlinteger) units (bitsps, Bps => bitsps * 8, Kbps => Bps * 1000, Mbps => Kbps * 1000, Gbps => Mbps * 1000 ); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Deactivate_Deadline: Time applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Deactivate_Execution_Time: Time_Range applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Deactivate_Entrypoint: aadlstring applies to (thread); ") ; Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Deadline: inherit Time => value(Period) applies to (thread, thread group, process, system, device); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Dequeue_Protocol: enumeration (OneItem, AllItems) => OneItem applies to (event port, event data port); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Device_Dispatch_Protocol: Supported_Dispatch_Protocols => Aperiodic applies to (device); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Device_Register_Address: aadlinteger applies to (port, port group); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Dispatch_Protocol: Supported_Dispatch_Protocols applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Expected_Latency: Time applies to (flow); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Expected_Throughput: Data_Volume applies to (flow); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Finalize_Deadline: Time applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Finalize_Execution_Time: Time_Range applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Finalize_Entrypoint: aadlstring applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Hardware_Description_Source_Text: inherit list of aadlstring applies to (memory, bus, device, processor, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Hardware_Source_Language: Supported_Hardware_Source_Languages applies to (memory, bus, device, processor, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Initialize_Deadline: Time applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Initialize_Execution_Time: Time_Range applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Initialize_Entrypoint: aadlstring applies to (thread); ") ; Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Latency: Time applies to (flow, connections); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Load_Deadline: Time applies to (process, system); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Load_Time: Time_Range applies to (process, system); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Memory_Protocol: enumeration (read_only, write_only, read_write) => read_write applies to (memory); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Not_Collocated: list of reference (data, thread, process, system, connections) applies to (data, thread, process, system, connections); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Overflow_Handling_Protocol: enumeration (DropOldest, DropNewest, Error) => DropOldest applies to (event port, event data port, subprogram); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Period: inherit Time applies to (thread, thread group, process, system, device); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Process_Swap_Execution_Time: Time_Range applies to (processor); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Propagation_Delay: Time_Range applies to (bus); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Provided_Access : access enumeration (read_only, write_only, read_write, by_method) => read_write applies to (data, bus); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Queue_Processing_Protocol: Supported_Queue_Processing_Protocols => FIFO applies to (event port, event data port, subprogram); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Queue_Size: aadlinteger 0 .. value(Max_Queue_Size) => 0 applies to (event port, event data port, subprogram); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Read_Time: list of Time_Range applies to (memory); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Recover_Deadline: Time applies to (thread, server subprogram); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Recover_Execution_Time: Time_Range applies to (thread, server subprogram); ") ; Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Recover_Entrypoint: aadlstring applies to (thread); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Required_Access : access enumeration (read_only, write_only, read_write, by_method) => read_write applies to (data, bus); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Required_Connection : aadlboolean => true applies to (port); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Runtime_Protection : inherit aadlboolean => true applies to (process, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Scheduling_Protocol: list of Supported_Scheduling_Protocols applies to (processor); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Server_Subprogram_Call_binding: inherit list of reference (thread, processor) applies to (subprogram, thread, thread group, process, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Size: type aadlinteger 0 B .. value (Max_Memory_Size) units Size_Units; "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Size_Range: type range of Size; "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Source_Code_Size: Size applies to (data, thread, thread group, process, system, subprogram, processor, device); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Source_Data_Size: Size applies to (data, subprogram, thread, thread group, process, system, processor, device); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Source_Heap_Size: Size applies to (thread, subprogram); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Source_Language: inherit Supported_Source_Languages applies to (subprogram, data, thread, thread group, process, bus, device, processor, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Source_Name: aadlstring applies to (data, port, subprogram, parameter); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Source_Stack_Size: Size applies to (thread, subprogram, processor, device); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Source_Text: inherit list of aadlstring applies to (data, port, subprogram, thread, thread group, process, system, memory, bus, device, processor, parameter, port group); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Startup_Deadline: inherit Time applies to (processor, system); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Subprogram_Execution_Time: Time_Range applies to (subprogram); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Supported_Source_Language: list of Supported_Source_Languages applies to (processor, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Synchronized_Component: inherit aadlboolean => true applies to (thread, thread group, process, system); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Thread_Limit: aadlinteger 0 .. value(Max_Thread_Limit) => value(Max_Thread_Limit) applies to (processor); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Thread_Swap_Execution_Time: Time_Range applies to (processor, system); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Throughput: Data_Volume applies to (flow, connections); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Time: type aadlinteger 0 ps .. value(Max_Time) units Time_Units; "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Time_Range: type range of Time; "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Transmission_Time: list of Time_Range applies to (bus); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Type_Source_Name: aadlstring applies to (data, port, subprogram); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Urgency: aadlinteger 0 .. value(Max_Urgency) applies to (port); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Word_Count: aadlinteger 0 .. value(Max_Word_Count) applies to (memory); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Word_Size: Size => 8 bits applies to (memory); "); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String( " Word_Space: aadlinteger 1 .. value(Max_Word_Space) => 1 applies to (memory); " ); Result := Result & ASCII.LF & ASCII.HT & To_Unbounded_String (" Write_Time: list of Time_Range applies to (memory); "); Result := Result & ASCII.LF & To_Unbounded_String (" end AADL_Properties;"); Result := Result & unbounded_lf & unbounded_lf & unbounded_lf; return Result; end Export_Aadl_Standard_Properties; function Export_Aadl_Project_Properties (A_System : in System) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := Result & To_Unbounded_String ("property set AADL_Project is") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Default_Active_Thread_Handling_Protocol : constant Supported_Active_Thread_Handling_Protocols => abort;" ) & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Max_Aadlinteger : constant aadlinteger => 2#1#e32;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Max_Memory_Size : constant aadlinteger Size_Units => 2#1#e32 B;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Max_Queue_Size : constant aadlinteger => 512;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Max_Base_Address : constant aadlinteger => 512;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Max_Urgency : constant aadlinteger => 12;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Max_Time : constant aadlinteger Time_Units => 1000 Hr;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Max_Thread_Limit : constant aadlinteger => 32;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Max_Word_Count : constant aadlinteger => 64000;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Max_Word_Space : constant aadlinteger => 64;") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Supported_Active_Thread_Handling_Protocols : type enumeration (abort, complete_one_flush_queue, complete_one_transfer_queue, complete_one_preserve_queue, complete_all);" ) & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Supported_Connection_Protocols : type enumeration (UDP, TCP);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Supported_Dispatch_Protocols : type enumeration (Periodic, Background, Poisson_Process, Sporadic, User_Defined);" ) & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Supported_Concurrency_Control_Protocols : type enumeration (No_Protocol, Priority_Ceiling_Protocol, Immediate_Priority_Ceiling_Protocol, Priority_Inheritance_Protocol);" ) & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Supported_Hardware_Source_Languages : type enumeration (VHDL);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Supported_Scheduling_Protocols : type enumeration ("); for I in Schedulers_Type'First .. Schedulers_Type'Last loop Result := Result & To_Unbounded_String (Schedulers_Type'Image (I)); if I /= Schedulers_Type'Last then Result := Result & To_Unbounded_String (", "); else Result := Result & To_Unbounded_String (");") & unbounded_lf; end if; end loop; Result := Result & To_Unbounded_String (ASCII.HT & "Supported_Queue_Processing_Protocols : type enumeration (FIFO);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Supported_Source_Languages : type enumeration (Ada95, C);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Time_Units : type units (ps, Ns => ps * 1000, Us => Ns * 1000, Ms => Us * 1000, Sec => Ms * 1000, Min => Sec * 60, Hr => Min * 60);" ) & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Size_Units : type units (Bits, B => Bits * 8, KB => B * 1000, MB => KB * 1000, GB => MB * 1000);" ) & unbounded_lf; Result := Result & To_Unbounded_String ("end AADL_Project;") & unbounded_lf; return Result; end Export_Aadl_Project_Properties; -- Export cheddar's specific properties -- function Export_Aadl_Cheddar_Properties (A_System : in System) return Unbounded_String is Result : Unbounded_String; begin Result := Result & unbounded_lf & To_Unbounded_String ("property set Cheddar_Properties is") & unbounded_lf; -- Thread and thread group properties -- Result := Result & To_Unbounded_String (ASCII.HT & "Dispatch_Seed_is_Predictable : aadlboolean") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Context_Switch_Overhead : inherit Time") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; Result := Result & ASCII.HT & To_Unbounded_String( "Source_Text : inherit list of aadlstring applies to (process, processor, thread, system);" ) & unbounded_lf & To_Unbounded_String (ASCII.HT & "-- Source_Text specifies the name of .sc files. This property can contains several .sc file names." & ASCII.LF & ASCII.HT & "-- In this case, the file names are separeted by a comma. " & ASCII.LF & ASCII.HT & "-- The .sc files contain pieces of code which can be interpreted by the " & ASCII.LF & ASCII.HT & "-- scheduling engine of Cheddar. These part of code are part of user-defined schedulers. With such .sc files, " & ASCII.LF & ASCII.HT & "-- one can design and perform simulations with specific thread dispatching protocols or specific scheduling protocols." & ASCII.LF & ASCII.HT & "-- " & ASCII.LF); Result := Result & ASCII.HT & To_Unbounded_String( "Automaton_Name : inherit list of aadlstring applies to (process, processor, thread);" ) & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Dispatch_Seed_Value : aadlinteger") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Dispatch_Absolute_Time : inherit Time ") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Criticality : aadlinteger") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Bound_On_Data_Blocking_Time : inherit Time ") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Dispatch_Jitter : inherit Time ") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Fixed_Priority : aadlinteger 0..255") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "POSIX_Scheduling_Policy : enumeration (SCHED_FIFO, SCHED_RR, SCHED_OTHERS)") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; for I in Offsets_Range'Range loop Result := Result & To_Unbounded_String (ASCII.HT & "Dispatch_Offset_Value_" & To_String (integer_util.format (Integer (I))) & " : aadlinteger") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Dispatch_Offset_Time_" & To_String (integer_util.format (Integer (I))) & " : inherit Time ") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (thread, thread group);") & unbounded_lf; end loop; -- System properties -- Result := Result & To_Unbounded_String (ASCII.HT & "Task_Precedencies : list of aadlstring") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (system);") & unbounded_lf; -- Processor properties -- Result := Result & unbounded_lf & To_Unbounded_String (ASCII.HT & "Scheduler_Quantum : inherit Time ") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (processor, process);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Preemptive_Scheduler : aadlboolean") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (processor, process);") & unbounded_lf & unbounded_lf; Result := Result & unbounded_lf & To_Unbounded_String (ASCII.HT & "Scheduling_Protocol : list of Supported_Scheduling_Protocols ") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (processor, process);") & unbounded_lf; -- Data properties -- Result := Result & unbounded_lf & To_Unbounded_String (ASCII.HT & "Data_Concurrency_State : aadlinteger") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (data);") & unbounded_lf & unbounded_lf; -- Process properties -- Result := Result & To_Unbounded_String (ASCII.HT & "Critical_Section : list of aadlstring") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (process, thread, data);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Source_Global_Heap_Size : Size ") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (process);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Source_Global_Stack_Size : Size ") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (process);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Source_Global_Text_Size : Size ") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (process);") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "Source_Global_Data_Size : Size ") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "applies to (process);") & unbounded_lf & unbounded_lf; Result := Result & To_Unbounded_String ("end Cheddar_Properties;") & unbounded_lf & unbounded_lf; return Result; end Export_Aadl_Cheddar_Properties; function Export_Aadl_Implementations (A_System : in System) return Unbounded_String is Result : Unbounded_String := empty_string; Tmp : Unbounded_String := empty_string; begin -- Export all sub-components of the system -- Result := Result & Export_Aadl_Implementations (A_System.Resources); Result := Result & Export_Aadl_Implementations (A_System.Tasks, A_System.Resources); Result := Result & Export_Aadl_Implementations (A_System.Address_Spaces, A_System.Tasks, A_System.Resources); Result := Result & Export_Aadl_Implementations (A_System.Buffers); Result := Result & Export_Aadl_Implementations (A_System.Messages); Result := Result & Export_Aadl_Implementations (A_System.Networks); Result := Result & Export_Aadl_Implementations (A_System.Processors); -- Export the system composition -- Result := Result & unbounded_lf & To_Unbounded_String ("system Cheddar") & unbounded_lf; Result := Result & To_Unbounded_String ("end Cheddar;") & unbounded_lf; Result := Result & unbounded_lf; Result := Result & To_Unbounded_String ("system implementation Cheddar.Impl") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "subcomponents") & unbounded_lf; -- List all processors, processes and networks -- Result := Result & Export_Aadl_Declarations (A_System.Networks, 2); Result := Result & Export_Aadl_Declarations (A_System.Processors, 2); Result := Result & Export_Aadl_Declarations (A_System.Address_Spaces, 2); -- Properties related to the global system : processor and bus --connections, event -- analyzers, task precedencies -- Tmp := Export_Aadl_Properties (A_System.Address_Spaces, 2); Tmp := Tmp & Export_Aadl_Properties (A_System.Event_Analyzers, 2); Tmp := Tmp & Export_Aadl_Properties (A_System.Dependencies, 2); if Tmp /= empty_string then Result := Result & To_Unbounded_String (ASCII.HT & "properties") & unbounded_lf & Tmp; end if; Result := Result & To_Unbounded_String ("end Cheddar.Impl;") & unbounded_lf & unbounded_lf; return Result; end Export_Aadl_Implementations; function Export_Aadl_Declarations (A_System : in System; Number_Of_Ht : in Natural) return Unbounded_String is Result : Unbounded_String := empty_string; begin return Result; end Export_Aadl_Declarations; function Select_Cpu (Op1 : in Generic_Task_Ptr) return Boolean is begin return (Op1.cpu_name = Current_Processor_Name); end Select_Cpu; function Select_Cpu (Op1 : in Generic_Resource_Ptr) return Boolean is begin return (Op1.cpu_name = Current_Processor_Name); end Select_Cpu; function Select_Cpu (Op1 : in Buffer_Ptr) return Boolean is begin return (Op1.cpu_name = Current_Processor_Name); end Select_Cpu; procedure Check_Task_One_Critical_Section (Task_Name : in Unbounded_String; Task_cpu_name : in Unbounded_String; task_capacity : natural; Resource_Name : in Unbounded_String; Resource_cpu_Name : in Unbounded_String; a_critical_section : in Critical_Section) is begin -- -- Check if begin and end time are consistent -- if (a_critical_section.task_Begin <= 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Resource_Name & " ; " & Task_Name & " ; " & Lb_Task_Begin (Current_Language) & Lb_Must_Be (Current_Language) & lb_greater_than (current_language) & "0")); end if; if (a_critical_section.task_End <= 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Resource_Name & " ; " & Task_Name & " ; " & Lb_Task_End (Current_Language) & Lb_Must_Be (Current_Language) & lb_greater_than (current_language) & "0")); end if; if a_critical_section.task_Begin > a_critical_section.task_End then Raise_Exception (Invalid_Parameter'Identity, To_String (Resource_Name & " ; " & Task_Name & " ; " & Lb_Task_Begin (Current_Language) & Lb_Must_Be (Current_Language) & lb_less_or_equal_than (current_language) & Lb_Task_End (Current_Language) )); end if; -- Check that the critical section is consistent according to -- the task definition -- if (Natural (a_critical_section.task_End) > Task_capacity) then Raise_Exception (Invalid_Parameter'Identity, To_String (Resource_Name & " ; " & Task_Name & " ; " & Lb_Task_End (Current_Language) & Lb_Must_Be (Current_Language) & Lb_less_or_equal_than (Current_Language) & Lb_Capacity (Current_Language) )); end if; if (Natural (a_critical_section.task_Begin) > Task_capacity) then Raise_Exception (Invalid_Parameter'Identity, To_String (Resource_Name & " ; " & Task_Name & " ; " & Lb_Task_Begin (Current_Language) & Lb_Must_Be (Current_Language) & Lb_less_or_equal_than (Current_Language) & Lb_Capacity (Current_Language) )); end if; -- Check that the task is on the same processor that the -- resource -- if Task_cpu_name /= Resource_Cpu_Name then Raise_Exception (Invalid_Parameter'Identity, To_String (Resource_Name & " ; " & Task_Name & " ; " & Lb_Have_To_Be_On_The_Same_Processor (Current_Language))); end if; end Check_Task_One_Critical_Section; procedure Check_Task_Critical_Sections (My_Tasks : in Tasks_Set; Resource_Name : in Unbounded_String; Resource_Cpu_Name : in Unbounded_String; critical_sections : in Resource_Accesses_Table) is A_Task : Generic_Task_Ptr; begin -- Check each critical section -- for i in 0..critical_sections.nb_entries-1 loop A_task:=search_task(my_tasks, Critical_Sections.entries(i).item); Check_Task_One_Critical_Section (a_task.name, a_task.cpu_name, a_task.capacity, Resource_Name, Resource_cpu_Name, Critical_Sections.entries(i).data); end loop; -- Check that we have no duplicated critical section -- for i in 0..critical_sections.nb_entries-1 loop for j in 0..critical_sections.nb_entries-1 loop if (Critical_Sections.entries(i)=Critical_Sections.entries(j)) and (i/=j) then Raise_Exception (Invalid_Parameter'Identity, To_String (Critical_Sections.entries(i).item & " ; " & Resource_Name & " ; " & Lb_duplicated_critical_section(Current_Language))); end if; end loop; end loop; end Check_Task_Critical_Sections; -------------------------------------------------------- -- Functions to check if a task has a critical section -- in a given resource -------------------------------------------------------- function has_a_critical_section(cs_task : in generic_task_ptr; cs_resource : in generic_resource_ptr) return boolean is result : boolean := false; begin -- Check each critical section -- for i in 0..cs_resource.critical_sections.nb_entries-1 loop if (cs_task.name = cs_resource.Critical_Sections.entries(i).item) then result:=true; end if; end loop; return result; end has_a_critical_section; procedure Check_Task_Critical_Sections (A_sys : in system; task_name : in Unbounded_String; task_capacity : in integer; task_cpu_name : in Unbounded_String) is A_Resource : Generic_Resource_Ptr; My_Iterator : Resources_Iterator; begin if not is_empty (a_sys.Resources) then reset_iterator (a_sys.Resources, My_Iterator); loop current_element (a_sys.Resources, A_Resource, My_Iterator); for i in 0..a_resource.critical_sections.nb_entries-1 loop if(task_name = a_resource.Critical_Sections.entries(i).item) then Check_Task_One_Critical_Section (task_name, task_cpu_name, task_capacity, a_resource.Name, a_resource.cpu_Name, a_resource.Critical_Sections.entries(i).data); end if; end loop; exit when is_last_element (a_sys.Resources, My_Iterator); next_element (a_sys.Resources, My_Iterator); end loop; end if; end Check_Task_Critical_Sections; procedure Check_task_one_Buffer_Role (Task_Name : in Unbounded_String; task_capacity : integer; Buffer_Name : in Unbounded_String; a_buffer_role : buffer_role) is begin if (a_buffer_role.Size <= 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Buffer_Name & " ; " & Task_Name & " ; " & Lb_Size (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_than (Current_Language) & To_Unbounded_String ("0"))); end if; if (a_buffer_role.Time <= 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Buffer_Name & " ; " & Task_Name & " ; " & Lb_Time (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_than (Current_Language) & To_Unbounded_String ("0"))); end if; -- Check that capacity is <= time -- if Task_capacity < a_buffer_role.Time then Raise_Exception (Invalid_Parameter'Identity, To_String (Buffer_Name & " ; " & Task_Name & " ; " & Lb_Time (Current_Language) & Lb_Must_Be (Current_Language) & Lb_less_or_equal_than (Current_Language) & Lb_Capacity (Current_Language))); end if; end Check_task_one_Buffer_Role; procedure Check_Task_buffer_roles (My_Tasks : in Tasks_Set; Buffer_Name : in Unbounded_String; roles : in Buffer_Roles_Table) is A_Task : Generic_Task_Ptr; begin -- Check each buffer role -- for i in 0..roles.nb_entries-1 loop A_Task := Search_Task (My_Tasks, roles.entries(i).item); Check_Task_One_buffer_role (a_task.name, a_task.capacity, buffer_Name, roles.entries(i).data); end loop; -- Check that we have no duplicated buffer role -- for i in 0..roles.nb_entries-1 loop for j in 0..roles.nb_entries-1 loop if (roles.entries(i)=roles.entries(j)) and (i/=j) then Raise_Exception (Invalid_Parameter'Identity, To_String (roles.entries(i).item & " ; " & buffer_Name & " ; " & Lb_duplicated_buffer_role(Current_Language))); end if; end loop; end loop; end Check_task_Buffer_Roles; procedure Check_Task_buffer_roles (A_sys : in system; task_name : in Unbounded_String; task_capacity : in integer) is A_buffer : buffer_Ptr; My_Iterator : buffers_Iterator; begin if not is_empty (a_sys.buffers) then reset_iterator (a_sys.buffers, My_Iterator); loop current_element (a_sys.buffers, A_buffer, My_Iterator); for i in 0..a_buffer.roles.nb_entries-1 loop if(task_name = a_buffer.roles.entries(i).item) then Check_Task_One_buffer_role(task_name, task_capacity, a_buffer.Name, a_buffer.roles.entries(i).data); end if; end loop; exit when is_last_element (a_sys.buffers, My_Iterator); next_element (a_sys.buffers, My_Iterator); end loop; end if; end Check_Task_buffer_roles; function search_by_name(a_system : in system; name : in unbounded_string) return Generic_Object_Ptr is obj : Generic_Object_Ptr; begin if Task_Is_Present(a_system.tasks, name) then obj := Generic_Object_Ptr(Search_Task(a_system.tasks, name)); end if; if Processor_Is_Present(a_system.Processors, name) then obj := Generic_Object_Ptr(Search_Processor(a_system.Processors, name)); end if; if Core_Is_Present(a_system.Core_units, name) then obj := Generic_Object_Ptr(Search_Core_unit(a_system.Core_units, name)); end if; if Address_Space_Is_Present(a_system.Address_Spaces, name) then obj := Generic_Object_Ptr(Search_Address_Space(a_system.Address_Spaces, name)); end if; if Resource_Is_Present(a_system.Resources, name) then obj := Generic_Object_Ptr(Search_Resource(a_system.Resources, name)); end if; return obj; end search_by_name; end Systems;