------------------------------------------------------------------------------- ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real time scheduling analysis tool. -- This program provides services to automatically check performances -- of real time architectures. -- -- Copyright (C) 2002-2010, by Frank Singhoff, Alain Plantec, Jerome Legrand -- -- The Cheddar project was started in 2002 by -- the LISyC Team, University of Western Britanny. -- -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- ----------------------------------------------------------------------------- -- Last update : -- $Rev: 523 $ -- $Date: 2012-09-26 15:09:39 +0200 (Wed, 26 Sep 2012) $ -- $Author: fotsing $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with GNAT.OS_Lib; use GNAT.OS_Lib; with Ocarina.Analyzer.Queries; use Ocarina.Analyzer.Queries; with Ocarina.Configuration; with Ocarina.AADL.Parser; with Ocarina.AADL.Printer; with Ocarina.Analyzer; use Ocarina.Analyzer; with Ocarina.AADL; use Ocarina.AADL; with Types; use Types; with Ocarina.Debug; use Ocarina.Debug; with Ocarina.Entities; use Ocarina.Entities; with Ocarina.Entities.Components; use Ocarina.Entities.Components; with Ocarina.Entities.Properties; use Ocarina.Entities.Properties; with Ocarina.Entities.Components.Connections; use Ocarina.Entities.Components.Connections; with Ocarina.Nutils; use Ocarina.Nutils; with Ocarina.Nodes; use Ocarina.Nodes; with Ocarina.AADL_Values; use Ocarina.AADL_Values; with Ocarina.AADL.Printer.Properties; use Ocarina.AADL.Printer.Properties; with Ocarina.AADL.Printer.Components.Connections; use Ocarina.AADL.Printer.Components.Connections; with Ocarina.AADL.Printer.Components; use Ocarina.AADL.Printer.Components; with Ocarina.Parser; with Ocarina.Printer; use Ocarina.Printer; with Ada.Exceptions; use Ada.Exceptions; pragma Warnings (Off); with Ada.Numerics.Aux; use Ada.Numerics.Aux; pragma Warnings (On); with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Strings; use Ada.Strings; with Ada.Strings.Maps; use Ada.Strings.Maps; with Ada.Text_IO; use Ada.Text_IO; with Framework_Config; use Framework_Config; with Offsets; use Offsets; use Offsets.Offsets_Table_Package; with Parameters; use Parameters; use Parameters.User_Defined_Parameters_Table_Package; with Debug; use Debug; with Aadl_Config; use Aadl_Config; with Resources; use Resources; use Resources.resource_accesses; with Resource_Set; use Resource_Set; use Resource_Set.Generic_Resource_Set; with Message_Set; use Message_Set; use Message_Set.Generic_Message_Set; with Event_Analyzer_Set; use Event_Analyzer_Set; use Event_Analyzer_Set.Generic_Event_Analyzer_Set; with Tasks; use Tasks; with Task_Set; use Task_Set; use Task_Set.Generic_Task_Set; with Address_Spaces; use Address_Spaces; with Address_Space_Set; use Address_Space_Set; use Address_Space_Set.Generic_Address_Space_Set; with Buffers; use Buffers; use Buffers.Buffer_Roles_package; with Buffer_Set; use Buffer_Set; use Buffer_Set.Generic_Buffer_Set; with Task_Dependencies; use Task_Dependencies; with Time_Unit_Events; use Time_Unit_Events; use Time_Unit_Events.Time_Unit_Package; with Multiprocessor_Services_Interface; use Multiprocessor_Services_Interface; use Multiprocessor_Services_Interface.Scheduling_Result_Per_Processor_Package; with Queueing_Systems; use Queueing_Systems; with GNAT.Current_Exception; use GNAT.Current_Exception; with Scheduler_Interface; use Scheduler_Interface; with io_tools; use io_tools; with Translate; use Translate; with AADL_Parser_Interface; use AADL_Parser_Interface; use AADL_Parser_Interface.Processor_Binding_Package; with processors; use processors; with unbounded_strings; use unbounded_strings; with core_units; use core_units; use core_units.Core_Units_Table_Package; package body AADL_Parsers is -- Set to False means we have to reset Ocarina before -- re-initialize it. -- First_AADL_Parsing : Boolean := True; type Pass_Number_Type is new Integer range 1 .. 3; Critical_Section_List : unbounded_string_list; -- Look for an AADL file from a set of directory and load it into -- Ocarina. -- function Load_AADL_File_From_Directory (Root : Node_Id; File_Name : Unbounded_String; Dir_List : unbounded_string_list) return Node_Id is A_Dir : unbounded_string_ptr; List_Ite : unbounded_string_iterator; begin if not is_empty (Dir_List) then reset_head_iterator (Dir_List, List_Ite); loop current_element (Dir_List, A_Dir, List_Ite); Put_Debug ("Try to load AADL file " & A_Dir.all & GNAT.OS_Lib.Directory_Separator & File_Name); if can_be_read (A_Dir.all & Directory_Separator & File_Name) then Put_Debug ("Load AADL file " & A_Dir.all & Directory_Separator & File_Name); return Ocarina.AADL.Parser.Process (To_String (A_Dir.all & Directory_Separator & File_Name), Root); end if; if is_tail_element (Dir_List, List_Ite) then exit; end if; next_element (Dir_List, List_Ite); end loop; end if; if can_be_read (File_Name) then Put_Debug ("Load AADL file " & File_Name); return Ocarina.AADL.Parser.Process (To_String (File_Name), Root); else Put_Debug ("CAN NOT Load AADL file " & File_Name); end if; return Root; end Load_AADL_File_From_Directory; function Load_AADL_File_From_Directory (Root : Node_Id; File_Name : String; Dir_List : unbounded_string_list) return Node_Id is begin return Load_AADL_File_From_Directory (Root, To_Unbounded_String (File_Name), Dir_List); end Load_AADL_File_From_Directory; -- Information retrieved from the AADL parser -- Dummy_Identifier : Unbounded_String := To_Unbounded_String ("__missing_cheddar_aadl_cpu_identifier__"); Name : Unbounded_String; Deadline : Integer; Start_Time : Integer; Blocking_Time : Integer; Criticality : Integer; State : Integer; address : Integer; Size : Integer; Period : Integer; Capacity : Integer; Context_Switch_Overhead : Integer; CPU_Name : Unbounded_String; Address_Space_Name : Unbounded_String; Jitter : Integer; Policy : Policies; Task_Type : Tasks_Type; Seed : Integer; Predictable : Boolean; Quantum : Integer; Priority : Integer; priority_assignment : Priority_Assignment_Type; A_Scheduler : Schedulers_Type; A_Network : Unbounded_String; Protocol : Resources_Type; Is_Preemptive : Preemptives_Type; Text_Memory_Size : Integer; Heap_Memory_Size : Integer; Data_Memory_Size : Integer; Stack_Memory_Size : Integer; Parametric_File_Name : Unbounded_String; Automaton_Name : Unbounded_String; Roles : Buffer_Roles_Table; A_Role : Buffer_Role; Offset : Offsets_Table; A_Task_List_Entry : critical_section; A_Task_List : resource_accesses_Table; Param : User_Defined_Parameters_Table; Task1 : Generic_Task_Ptr; Ok : Boolean; CPU_Bindings : Processor_Binding_Table; procedure Initialize_Parsed_Data is begin State := 0; Size := 0; address := 0; Task_Type := Aperiodic_Type; Policy := Sched_Fifo; Is_Preemptive := preemptive; Seed := 0; Predictable := True; Priority := 1; priority_assignment := Automatic_Assignment; Name := To_Unbounded_String (""); Deadline := 0; Period := 0; Start_Time := 0; Criticality := 0; Blocking_Time := 0; Capacity := 0; Context_Switch_Overhead := 0; Jitter := 0; Quantum := 0; A_Scheduler := No_Scheduling_Protocol; Text_Memory_Size := 0; Heap_Memory_Size := 0; Data_Memory_Size := 0; Stack_Memory_Size := 0; Protocol := No_Protocol; State := 1; A_Network := To_Unbounded_String (""); Parametric_File_Name := To_Unbounded_String (""); CPU_Name := To_Unbounded_String (""); Address_Space_Name := To_Unbounded_String (""); Parametric_File_Name := To_Unbounded_String (""); Automaton_Name := To_Unbounded_String (""); Initialize (A_Task_List_Entry); initialize (A_Task_List); initialize (Offset); initialize (Param); initialize (Roles); Initialize (A_Role); initialize (CPU_Bindings); end Initialize_Parsed_Data; procedure Initialize_Project_Parser (Handler : in out AADL_Project_Parser) is begin Initialize (Handler.Parsed_System); Initialize_Parsed_Data; end Initialize_Project_Parser; function Get_Parsed_System (Handler : AADL_Project_Parser) return System is begin return Handler.Parsed_System; end Get_Parsed_System; procedure Initialize (Handler : in out AADL_Project_Parser) is begin Initialize (Handler.Parsed_System); Initialize_Parsed_Data; end Initialize; ------------------------------------------------------------------------ -- Parse AADL properties ------------------------------------------------------------------------ procedure Read_Property_Associations (Handler : in out AADL_Project_Parser; Component_Type : Node_Id; Component_Instance_Name : Unbounded_String; Path : Unbounded_String; Pass : Pass_Number_Type) is -- Display a property (debug only) -- procedure Display_Property (A_Property_Node : Node_Id) is begin if Aadl_Debug then if Pass = 1 then Put ("First"); elsif Pass = 2 then Put ("Second"); else Put ("Third"); end if; Put (" pass ; "); Print_Property_Association (A_Property_Node, Default_Output_Options); end if; end Display_Property; -- AADL enumeration properties -- procedure Read_Concurrency_Control_Protocol_Property (A_Property_Value : Node_Id) is Protocol_String : Unbounded_String; begin Protocol_String := to_lower (To_Unbounded_String (Get_Enumeration_Of_Property_Value (A_Property_Value))); To_Resources_Type (to_upper (Protocol_String), Protocol, Ok); if not Ok then Raise_Exception (AADL_Read_Error'Identity, "Property Concurrency_Control_Protocol should store a valid" & " protocol name"); end if; end Read_Concurrency_Control_Protocol_Property; procedure Read_Scheduling_Protocol_Property (A_Property_Value : Node_Id) is Scheduler_Name : Unbounded_String; begin Scheduler_Name := To_Unbounded_String (Get_Enumeration_Of_Property_Value (A_Property_Value)); To_Schedulers_Type (to_upper (Scheduler_Name), A_Scheduler, Ok); if not Ok then Raise_Exception (AADL_Read_Error'Identity, "Property Scheduling_Protocol should store a valid" & " scheduler name"); end if; end Read_Scheduling_Protocol_Property; procedure Read_Dispatch_Protocol_Property (A_Property_Value : Node_Id) is Activation : Unbounded_String; begin Activation := to_lower (To_Unbounded_String (Get_Enumeration_Of_Property_Value (A_Property_Value))); if Activation = "periodic" then Task_Type := Periodic_Type; elsif Activation = "user_defined" then Task_Type := Parametric_Type; elsif Activation = "poisson_process" then Task_Type := Poisson_Type; elsif Activation = "sporadic" then Task_Type := Sporadic_Type; elsif Activation = "background" then Task_Type := Aperiodic_Type; else Raise_Exception (AADL_Read_Error'Identity, "Property Dispatch_Protocol should store" & " Periodic, Sporadic, Background, Poisson_Process" & " or User_Defined"); end if; end Read_Dispatch_Protocol_Property; procedure Read_Posix_Scheduling_Policy_Property (A_Property_Value : Node_Id) is Policy_String : Unbounded_String; begin Policy_String := (To_Unbounded_String (Get_Enumeration_Of_Property_Value (A_Property_Value))); To_Policies (to_upper (Policy_String), Policy, Ok); if not Ok then Raise_Exception (AADL_Read_Error'Identity, "Property POSIX_Scheduling_Policy should store " & "SCHED_FifO, SCHED_OTHERS or SCHED_RR"); end if; end Read_Posix_Scheduling_Policy_Property; -- AADLinteger/AADLfloat properties -- procedure Read_Compute_Execution_Time_Property (A_Property_Value : Node_Id) is begin Capacity := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (Upper_Bound (A_Property_Value))))); end Read_Compute_Execution_Time_Property; procedure Read_Period_Property (A_Property_Value : Node_Id) is begin Period := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Period_Property; procedure Read_Context_Switch_Overhead_Property (A_Property_Value : Node_Id) is begin Context_Switch_Overhead := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Context_Switch_Overhead_Property; procedure Read_Deadline_Property (A_Property_Value : Node_Id) is begin Deadline := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Deadline_Property; procedure Read_Data_Concurrency_State_Property (A_Property_Value : Node_Id) is begin State := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Data_Concurrency_State_Property; procedure Read_Source_Code_Size_Property (A_Property_Value : Node_Id) is begin Text_Memory_Size := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Source_Code_Size_Property; procedure Read_Source_Data_Size_Property (A_Property_Value : Node_Id) is begin Data_Memory_Size := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Source_Data_Size_Property; procedure Read_Source_Heap_Size_Property (A_Property_Value : Node_Id) is begin Heap_Memory_Size := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Source_Heap_Size_Property; procedure Read_Source_Stack_Size_Property (A_Property_Value : Node_Id) is begin Stack_Memory_Size := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Source_Stack_Size_Property; procedure Read_Criticality_Property (A_Property_Value : Node_Id) is begin Criticality := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Criticality_Property; procedure Read_Scheduler_Quantum_Property (A_Property_Value : Node_Id) is begin Quantum := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Scheduler_Quantum_Property; procedure Read_Fixed_Priority_Property (A_Property_Value : Node_Id) is begin Priority := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Fixed_Priority_Property; procedure Read_Dispatch_Jitter_Property (A_Property_Value : Node_Id) is begin Jitter := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Dispatch_Jitter_Property; procedure Read_Bound_On_Data_Blocking_Time_Property (A_Property_Value : Node_Id) is begin Blocking_Time := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Bound_On_Data_Blocking_Time_Property; procedure Read_Dispatch_Absolute_Time_Property (A_Property_Value : Node_Id) is begin Start_Time := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Dispatch_Absolute_Time_Property; procedure Read_Dispatch_Seed_Value_Property (A_Property_Value : Node_Id) is begin Seed := Integer'Value (Ocarina.AADL_Values.Image (Value (Number_Value (A_Property_Value)))); end Read_Dispatch_Seed_Value_Property; -- AADL list properties -- procedure Read_Task_Precedencies_Property (A_Property_Node : Node_Id; A_Property_Value : Node_Id) is A_Thread1 : Generic_Task_Ptr; A_Thread2 : Generic_Task_Ptr; List_Head : List_Id; List_Node : Node_Id; Thread2_Name : Unbounded_String; Thread1_Name : Unbounded_String; begin if not Is_Defined_List_Property (A_Property_Node, "cheddar_properties::task_precedencies") then Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Task_Precedencies property can not be found"); end if; List_Head := Ocarina.Analyzer.Queries.Get_List_Property (A_Property_Node, "cheddar_properties::task_precedencies"); List_Node := First_Node (List_Head); -- Parse task precedencies now -- while Present (List_Node) loop -- Get the two thread names -- if Present (List_Node) then Thread1_Name := to_lower (To_Unbounded_String (Ocarina.AADL_Values.Image (Value (List_Node)))); Thread1_Name := To_Unbounded_String (Slice (Thread1_Name, 2, Length (Thread1_Name) - 1)); else Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Task_Precedencies layout error (1)"); end if; List_Node := Next_Node (List_Node); if Present (List_Node) then Thread2_Name := to_lower (To_Unbounded_String (Ocarina.AADL_Values.Image (Value (List_Node)))); Thread2_Name := To_Unbounded_String (Slice (Thread2_Name, 2, Length (Thread2_Name) - 1)); else Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Task_Precedencies layout error (2)"); end if; List_Node := Next_Node (List_Node); -- Full path thread name -- Thread1_Name := Path & Thread1_Name; Thread2_Name := Path & Thread2_Name; begin A_Thread1 := Search_Task (Handler.Parsed_System.Tasks, Thread1_Name); exception when Task_Not_Found => Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Task_Precedencies ; thread " & To_String (Thread1_Name) & " not found"); when Task_Set.Generic_Task_Set.empty_set => Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Task_Precedencies ; thread " & To_String (Thread1_Name) & " not found in empty set"); end; begin A_Thread2 := Search_Task (Handler.Parsed_System.Tasks, Thread2_Name); exception when Task_Not_Found => Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Task_Precedencies ; thread " & To_String (Thread2_Name) & " not found"); when Task_Set.Generic_Task_Set.empty_set => Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Task_Precedencies ; thread " & To_String (Thread2_Name) & " not found in empty set"); end; -- Add the new task precedency -- Add_One_Task_Dependency_precedence (Handler.Parsed_System.Dependencies, A_Thread1, A_Thread2); end loop; end Read_Task_Precedencies_Property; procedure Read_Critical_Section_Property (A_Property_Node : Node_Id; A_Property_Value : Node_Id) is A_Resource : Generic_Resource_Ptr; List_Node : Node_Id; List_Head : List_Id; Cs_Start, Cs_End, Resource_Name, Thread_Name : Unbounded_String; Integer_Ok : Boolean; Integer_Cs_Start, Integer_Cs_End : Integer; Resource_Str_Ptr : unbounded_string_ptr; begin if not Is_Defined_List_Property (A_Property_Node, "cheddar_properties::critical_section") then Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Critical_Section property can not be found"); end if; List_Head := Ocarina.Analyzer.Queries.Get_List_Property (A_Property_Node, "cheddar_properties::critical_section"); List_Node := First_Node (List_Head); -- Parse critical sections now -- while Present (List_Node) loop -- Resource name -- if Present (List_Node) then Resource_Name := to_lower (To_Unbounded_String (Ocarina.AADL_Values.Image (Value (List_Node)))); Resource_Name := To_Unbounded_String (Slice (Resource_Name, 2, Length (Resource_Name) - 1)); else Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Critical_Section value list " & "should start with a resource name"); end if; -- Thread name -- List_Node := Next_Node (List_Node); if Present (List_Node) then Thread_Name := to_lower (To_Unbounded_String (Ocarina.AADL_Values.Image (Value (List_Node)))); Thread_Name := To_Unbounded_String (Slice (Thread_Name, 2, Length (Thread_Name) - 1)); else Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Critical_Section, Thread name " & "of critical section is missing"); end if; -- Start of the critical section -- List_Node := Next_Node (List_Node); if Present (List_Node) then Cs_Start := To_Unbounded_String (Ocarina.AADL_Values.Image (Value (List_Node))); Cs_Start := To_Unbounded_String (Slice (Cs_Start, 2, Length (Cs_Start) - 1)); else Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Critical_Section, Start of critical " & "section is missing"); end if; -- End of the critical section -- List_Node := Next_Node (List_Node); if Present (List_Node) then Cs_End := To_Unbounded_String (Ocarina.AADL_Values.Image (Value (List_Node))); Cs_End := To_Unbounded_String (Slice (Cs_End, 2, Length (Cs_End) - 1)); else Raise_Exception (AADL_Read_Error'Identity, "Cheddar_Properties::Critical_Section, End of critical " & "section is missing"); end if; Put_Debug ("Critical section : " & To_String (Resource_Name & Thread_Name & Cs_Start & Cs_End)); List_Node := Next_Node (List_Node); -- Parser/add the critical sections -- -- Full path resource name -- Resource_Name := Path & Component_Instance_Name & "." & Resource_Name; A_Resource := Search_Resource (Handler.Parsed_System.Resources, Resource_Name); -- Full path thread name -- Thread_Name := Path & Component_Instance_Name & "." & Thread_Name; to_integer (Cs_Start, Integer_Cs_Start, Integer_Ok); if not Ok then Raise_Exception (AADL_Read_Error'Identity, To_String (Lb_Task_Begin (Current_Language) & Lb_Must_Be_Numeric (Current_Language))); end if; to_integer (Cs_End, Integer_Cs_End, Integer_Ok); if not Integer_Ok then Raise_Exception (AADL_Read_Error'Identity, To_String (Lb_Task_End (Current_Language) & Lb_Must_Be_Numeric (Current_Language))); end if; -- Add the new critical section -- A_Resource.critical_sections.entries (A_Resource.critical_sections.nb_entries).item := Thread_Name; A_Resource.critical_sections.entries (A_Resource.critical_sections.nb_entries).data. task_begin := Integer_Cs_Start; A_Resource.critical_sections.entries (A_Resource.critical_sections.nb_entries).data. task_end := Integer_Cs_End; A_Resource.critical_sections.nb_entries := A_Resource.critical_sections.nb_entries + 1; Resource_Str_Ptr := new Unbounded_String; Resource_Str_Ptr.all := A_Resource.name; add (Critical_Section_List, Resource_Str_Ptr); end loop; end Read_Critical_Section_Property; procedure Read_Source_Text_Property (A_Property_Value : Node_Id) is begin Parametric_File_Name := To_Unbounded_String (Ocarina.AADL_Values.Image (Value (A_Property_Value))); Parametric_File_Name := To_Unbounded_String (Slice (Parametric_File_Name, 2, Length (Parametric_File_Name) - 1)); end Read_Source_Text_Property; procedure Read_Automaton_Name_Property (A_Property_Value : Node_Id) is begin Automaton_Name := To_Unbounded_String (Ocarina.AADL_Values.Image (Value (A_Property_Value))); Automaton_Name := To_Unbounded_String (Slice (Automaton_Name, 2, Length (Automaton_Name) - 1)); end Read_Automaton_Name_Property; procedure Read_Actual_Processor_Binding_Property (List_Node : Node_Id; A_Property_Node : Node_Id) is A_Binding : Binding_Record_Type; Applies_To : constant List_Id := Applies_To_Prop (List_Node); It_Node : Node_Id; begin It_Node := First_Node (Applies_To); while Present (It_Node) loop Address_Space_Name := to_lower (To_Unbounded_String (Image (Display_Name (It_Node)))); It_Node := Next_Node (It_Node); end loop; CPU_Name := to_lower (To_Unbounded_String (Get_Name_Of_Entity_Reference (A_Property_Node))); A_Binding.cpu_name := Path & CPU_Name; A_Binding.address_space_name := Path & Address_Space_Name; add (CPU_Bindings, A_Binding); if Aadl_Debug then Put_Line ("Process/processor binding = " & To_String (A_Binding.address_space_name) & "/" & To_String (A_Binding.cpu_name)); end if; end Read_Actual_Processor_Binding_Property; -- AADL boolean properties -- procedure Read_Dispatch_Seed_Is_Predictable_Property (A_Property_Value : Node_Id) is begin Predictable := Get_Boolean_Of_Property_Value (A_Property_Value); end Read_Dispatch_Seed_Is_Predictable_Property; procedure Read_Preemptive_Scheduler_Property (A_Property_Value : Node_Id) is begin if Get_Boolean_Of_Property_Value (A_Property_Value) then Is_Preemptive := preemptive; else Is_Preemptive := not_preemptive; end if; end Read_Preemptive_Scheduler_Property; -- Main Read property subprogram -- List_Node : Node_Id; Property_Name : Unbounded_String; User_Defined_Properties : Unbounded_String; A_Property_Value : Node_Id; Val : Node_Id; A_Param : Parameter_Ptr; begin if not Is_Empty (Ocarina.Nodes.Properties (Component_Type)) then List_Node := First_Node (Ocarina.Nodes.Properties (Component_Type)); while Present (List_Node) loop -- The property name -- Property_Name := to_lower (To_Unbounded_String (Image (Display_Name (Identifier (List_Node))))); A_Property_Value := Compute_Property_Value (Property_Association_Value (List_Node)); Display_Property (List_Node); if Pass = 1 then -- Scan AADL default properties -- if Property_Name = To_Unbounded_String ("compute_execution_time") then Read_Compute_Execution_Time_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("concurrency_control_protocol") then Read_Concurrency_Control_Protocol_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("deadline") then Read_Deadline_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("period") then Read_Period_Property (A_Property_Value); end if; if (Property_Name = To_Unbounded_String ("scheduling_protocol")) or (Property_Name = To_Unbounded_String ("cheddar_properties::scheduling_protocol")) then Read_Scheduling_Protocol_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::source_text") then Read_Source_Text_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::context_switch_overhead") then Read_Context_Switch_Overhead_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::automaton_name") then Read_Automaton_Name_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("dispatch_protocol") then Read_Dispatch_Protocol_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("source_code_size") then Read_Source_Code_Size_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("source_data_size") then Read_Source_Data_Size_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("source_heap_size") then Read_Source_Heap_Size_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::criticality") then Read_Criticality_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("source_stack_size") then Read_Source_Stack_Size_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::source_global_text_size") then Read_Source_Code_Size_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::source_global_data_size") then Read_Source_Data_Size_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::source_global_heap_size") then Read_Source_Heap_Size_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::source_global_stack_size") then Read_Source_Stack_Size_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::scheduler_quantum") then Read_Scheduler_Quantum_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::posix_scheduling_policy") then Read_Posix_Scheduling_Policy_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::fixed_priority") then Read_Fixed_Priority_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::dispatch_jitter") then Read_Dispatch_Jitter_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::bound_on_data_blocking_time") then Read_Bound_On_Data_Blocking_Time_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::dispatch_absolute_time") then Read_Dispatch_Absolute_Time_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::dispatch_seed_value") then Read_Dispatch_Seed_Value_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::dispatch_seed_is_predictable") then Read_Dispatch_Seed_Is_Predictable_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::preemptive_scheduler") then Read_Preemptive_Scheduler_Property (A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::data_concurrency_state") then Read_Data_Concurrency_State_Property (A_Property_Value); end if; -- Scan task user defined properties -- if Length (Property_Name) > 33 then User_Defined_Properties := To_Unbounded_String (Slice (Property_Name, 1, 33)); else User_Defined_Properties := empty_string; end if; if User_Defined_Properties = "user_defined_cheddar_properties::" then Val := Ocarina.Analyzer.Queries.Get_Value_Of_Property_Association (Component_Type, Image (Display_Name (Identifier (List_Node)))); User_Defined_Properties := To_Unbounded_String (Slice (Property_Name, 34, Length (Property_Name))); -- Find the property value type -- case Get_Type_Of_Property_Value (Val, True) is -- AADL float value of a float user defined parameter -- when PT_Float | PT_Unsigned_Float => A_Param := new Parameter (Double_Parameter); A_Param.double_value := Ada.Numerics.Aux.Double ( Get_Float_Of_Property_Value (A_Property_Value)); A_Param.parameter_name := User_Defined_Properties; add (Param, A_Param); -- AADL integer value of an integer user defined parameter -- when PT_Integer | PT_Unsigned_Integer => A_Param := new Parameter (Integer_Parameter); A_Param.integer_value := Integer (Get_Integer_Of_Property_Value (A_Property_Value)); A_Param.parameter_name := User_Defined_Properties; add (Param, A_Param); -- AADL boolean value of a boolean user defined parameter -- when PT_Boolean => A_Param := new Parameter (Boolean_Parameter); A_Param.boolean_value := Get_Boolean_Of_Property_Value (A_Property_Value); A_Param.parameter_name := User_Defined_Properties; add (Param, A_Param); when others => Raise_Exception (AADL_Read_Error'Identity, "Can not find task user defined parameter type"); end case; end if; end if; if Pass = 2 then if Property_Name = To_Unbounded_String ("actual_processor_binding") then Read_Actual_Processor_Binding_Property (List_Node, A_Property_Value); end if; end if; if Pass = 3 then if Property_Name = To_Unbounded_String ("cheddar_properties::task_precedencies") then Read_Task_Precedencies_Property (Component_Type, A_Property_Value); end if; if Property_Name = To_Unbounded_String ("cheddar_properties::critical_section") then Read_Critical_Section_Property (Component_Type, A_Property_Value); end if; end if; List_Node := Next_Node (List_Node); end loop; end if; end Read_Property_Associations; ------------------------------------------- -- AADL syntax tree reading sub-programs ------------------------------------------- procedure First_Pass (Handler : in out AADL_Project_Parser; Root : Node_Id) is procedure Add_Data_Component (List_Node : Node_Id; Identifier_Path : Unbounded_String; Parent_Component_Name : Unbounded_String) is begin Name := to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))); Add_Resource (Handler.Parsed_System.Resources, Identifier_Path & Parent_Component_Name & "." & Name, State, Size, address, Dummy_Identifier, Identifier_Path & Parent_Component_Name, Protocol, A_Task_List, Priority, priority_assignment); end Add_Data_Component; procedure Add_Thread_Component (List_Node : Node_Id; Identifier_Path : Unbounded_String; Parent_Component_Name : Unbounded_String) is begin Name := to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))); Add_Task (Handler.Parsed_System.Tasks, Task1, Identifier_Path & Parent_Component_Name & "." & Name, Dummy_Identifier, Identifier_Path & Parent_Component_Name, Task_Type, Start_Time, Capacity, Period, Deadline, Jitter, Blocking_Time, Priority, Criticality, Policy, Offset, Stack_Memory_Size, Text_Memory_Size, Param, Parametric_File_Name, Seed, Predictable, Context_Switch_Overhead); end Add_Thread_Component; procedure Add_Process_Component (List_Node : Node_Id; Identifier_Path : Unbounded_String) is begin Name := to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))); Add_Address_Space (Handler.Parsed_System.Address_Spaces, Identifier_Path & Name, Dummy_Identifier, Text_Memory_Size, Stack_Memory_Size, Data_Memory_Size, Heap_Memory_Size, Is_Preemptive, Quantum, Parametric_File_Name, A_Scheduler, Automaton_Name); end Add_Process_Component; procedure Add_Processor_Component (List_Node : Node_Id; Identifier_Path : Unbounded_String) is a_core : core_unit_ptr; begin Name := to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))); Add_core_unit (Handler.Parsed_System.core_units, a_core, to_unbounded_string("core_unit_") & Identifier_Path & Name, Is_Preemptive, Quantum, 0.0, Capacity, Period, Priority, Parametric_File_Name, A_Scheduler, Automaton_Name); Add_Processor (Handler.Parsed_System.processors, Identifier_Path & Name, A_Network, a_core); end Add_Processor_Component; procedure Add_Event_Analyzers (Name : Unbounded_String) is -- A pair of index objects to keep track of the beginning and -- ending of the tokens isolated from the string: -- First : Natural; Last : Positive; -- A character set consisting of the "whitespace" characters -- that separate the tokens: -- Comma : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set (","); Subname, Token : Unbounded_String; begin Subname := Name; loop Find_Token (Subname, Set => Comma, Test => Ada.Strings.Outside, First => First, Last => Last); Token := To_Unbounded_String (Slice (Subname, First, Last)); Subname := To_Unbounded_String (Slice (Subname, Last + 1, Length (Subname))); Check_Event_Analyzer (Handler.Parsed_System.Event_Analyzers, Token, Token); Add_Event_Analyzer (Handler.Parsed_System.Event_Analyzers, Token, Token); exit when Length (Subname) = 0; end loop; exception when others => Raise_Exception (AADL_Read_Error'Identity, Exception_Message); end Add_Event_Analyzers; function Find_Subcomponents (Parent_Component : Node_Id; Current_Process_Name : Unbounded_String; Identifier_Path : Unbounded_String; Level : Integer := 0) return Integer is List_Node : Node_Id; Component_Number : Integer := 0; Cat : Byte; Cat2 : Byte; Path : Unbounded_String := Identifier_Path; A_Process_Name : Unbounded_String := empty_string; begin if (Parent_Component /= No_Node) and (Kind (Parent_Component) = K_Component_Implementation) then if Subcomponents (Parent_Component) /= No_List then List_Node := First_Node (Subcomponents (Parent_Component)); while List_Node /= No_Node loop Component_Number := Component_Number + 1; -- We look for the component type -- if Entity_Ref (List_Node) /= No_Node then -- Get the type of the component -- Cat := Category (List_Node); if Aadl_Debug then Put_Line ("First pass ; Component name = " & Get_Name_Of_Entity (List_Node)); Put_Line ("First pass ; Component type = " & Get_Name_Of_Entity_Reference (Entity_Ref (List_Node))); end if; if Component_Category'Val (Cat) = CC_Data then -- We do not take into account data declared -- into another data (nested data). -- Get the type of the parent component -- Cat2 := Category (Parent_Component); if Component_Category'Val (Cat2) = CC_Process then Put_Debug ("Parsing an AADL data : " & Get_Name_Of_Entity (List_Node)); Initialize_Parsed_Data; Read_Property_Associations (Handler, Get_Referenced_Entity (Entity_Ref (List_Node)), to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Identifier_Path, 1); Add_Data_Component (List_Node, Identifier_Path, Current_Process_Name); end if; end if; if Component_Category'Val (Cat) = CC_Thread then Put_Debug ("Parsing an AADL thread : " & Get_Name_Of_Entity (List_Node)); Initialize_Parsed_Data; Read_Property_Associations (Handler, Get_Referenced_Entity (Entity_Ref (List_Node)), to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Identifier_Path, 1); Add_Thread_Component (List_Node, Identifier_Path, Current_Process_Name); end if; if Component_Category'Val (Cat) = CC_Process then Put_Debug ("Parsing an AADL process : " & Get_Name_Of_Entity (List_Node)); Initialize_Parsed_Data; A_Process_Name := to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))); Read_Property_Associations (Handler, Get_Referenced_Entity (Entity_Ref (List_Node)), to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Identifier_Path, 1); Add_Process_Component (List_Node, Identifier_Path); end if; if Component_Category'Val (Cat) = CC_Processor then Put_Debug ("Parsing an AADL processor : " & Get_Name_Of_Entity (List_Node)); Initialize_Parsed_Data; Read_Property_Associations (Handler, Get_Referenced_Entity (Entity_Ref (List_Node)), to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Identifier_Path, 1); Add_Processor_Component (List_Node, Identifier_Path); end if; if Component_Category'Val (Cat) = CC_System then Put_Debug ("Parsing an AADL system : " & Get_Name_Of_Entity (List_Node)); if Aadl_Import_With_System_Name then Path := to_lower (Identifier_Path & Get_Name_Of_Entity (List_Node) & ""); else Path := empty_string; end if; Initialize_Parsed_Data; Read_Property_Associations (Handler, Get_Referenced_Entity (Entity_Ref (List_Node)), to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Path, 1); if Parametric_File_Name /= empty_string then Add_Event_Analyzers (Parametric_File_Name); end if; end if; Component_Number := Component_Number + Find_Subcomponents (Get_Referenced_Entity (Entity_Ref (List_Node)), A_Process_Name, Path, Level + 1); else -- The component has no type ...currently, this -- is not supported. -- Raise_Exception (AADL_Read_Error'Identity, "Find_Processor_Component, AADL component must have " & "a type"); end if; List_Node := Next_Node (List_Node); end loop; end if; end if; return Component_Number; end Find_Subcomponents; List_Node : Node_Id := No_Node; Global_Component_Number : Integer := 0; Path : Unbounded_String; begin -- Find and create all Cheddar's object sets -- if Ocarina.Nodes.Declarations (Root) /= No_List then List_Node := First_Node (Ocarina.Nodes.Declarations (Root)); while List_Node /= No_Node loop if Kind (List_Node) = K_Component_Implementation and then Component_Category'Val (Category (List_Node)) = CC_System then Put_Debug ("Parsing a root AADL system component : " & Get_Name_Of_Entity (List_Node)); -- Read main system properties -- if Aadl_Import_With_System_Name then Path := to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node)) & "."); else Path := empty_string; end if; Read_Property_Associations (Handler, List_Node, to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Path, 1); if Parametric_File_Name /= empty_string then Add_Event_Analyzers (Parametric_File_Name); end if; -- Find AADL sub components -- Global_Component_Number := Find_Subcomponents (List_Node, empty_string, to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node)) & ".")); end if; List_Node := Next_Node (List_Node); end loop; end if; end First_Pass; procedure Second_Pass (Handler : in out AADL_Project_Parser; Root : Node_Id) is function Find_Subcomponents (Parent_Component : Node_Id; Identifier_Path : Unbounded_String; Level : Integer := 0) return Integer is List_Node : Node_Id; Component_Number : Integer := 0; Cat : Byte; Path : Unbounded_String := Identifier_Path; begin if Subcomponents (Parent_Component) /= No_List then List_Node := First_Node (Subcomponents (Parent_Component)); while List_Node /= No_Node loop Component_Number := Component_Number + 1; -- We look for the component type -- if (Entity_Ref (List_Node) /= No_Node) then -- Get the type of the component -- Cat := Category (List_Node); if Aadl_Debug then Put_Line ("Second pass ; Component name = " & Get_Name_Of_Entity (List_Node)); Put_Line ("Second pass ; Component type = " & Get_Name_Of_Entity_Reference (Entity_Ref (List_Node))); end if; if Component_Category'Val (Cat) = CC_Process then Read_Property_Associations (Handler, Get_Referenced_Entity (Entity_Ref (List_Node)), to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Identifier_Path, 2); end if; if Component_Category'Val (Cat) = CC_System then if Aadl_Import_With_System_Name then Path := to_lower (Identifier_Path & Get_Name_Of_Entity (List_Node) & ""); else Path := empty_string; end if; Read_Property_Associations (Handler, Get_Referenced_Entity (Entity (List_Node)), to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Identifier_Path, 2); end if; if (Component_Category'Val (Cat) = CC_System) or (Component_Category'Val (Cat) = CC_Process) then Component_Number := Component_Number + Find_Subcomponents (Get_Referenced_Entity (Entity_Ref (List_Node)), Path, Level + 1); end if; else -- The component has no type ... -- Currently, this is not supported -- Raise_Exception (AADL_Read_Error'Identity, "Find_Processor_Component, AADL component must have a type"); end if; List_Node := Next_Node (List_Node); end loop; end if; return Component_Number; end Find_Subcomponents; A_Buffer : Buffer_Ptr; My_Buffer_Iterator : Buffers_Iterator; A_Resource : Generic_Resource_Ptr; My_Resource_Iterator : Resources_Iterator; A_Task : Generic_Task_Ptr; My_Task_Iterator : Tasks_Iterator; An_Address_Space : Address_Space_Ptr; My_Iterator : Address_Spaces_Iterator; List_Node : Node_Id := No_Node; Global_Component_Number : Integer := 0; Path : Unbounded_String; begin Initialize_Parsed_Data; -- Find and perform analysis on all global systems -- if Ocarina.Nodes.Declarations (Root) /= No_List then List_Node := First_Node (Ocarina.Nodes.Declarations (Root)); while List_Node /= No_Node loop if Kind (List_Node) = K_Component_Implementation and then Component_Category'Val (Category (List_Node)) = CC_System then -- Read main system properties -- if Aadl_Import_With_System_Name then Path := to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node)) & "."); else Path := empty_string; end if; Read_Property_Associations (Handler, List_Node, to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Path, 2); -- Find AADL sub components -- Global_Component_Number := Find_Subcomponents (List_Node, to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node)) & ".")); end if; List_Node := Next_Node (List_Node); end loop; end if; -- Now, update processor bindings of address spaces -- if not is_empty (Handler.Parsed_System.Address_Spaces) then reset_iterator (Handler.Parsed_System.Address_Spaces, My_Iterator); loop current_element (Handler.Parsed_System.Address_Spaces, An_Address_Space, My_Iterator); -- Find the process name in the table and assign processor -- for I in 0 .. CPU_Bindings.nb_entries - 1 loop if CPU_Bindings.entries (I).address_space_name = An_Address_Space.name then An_Address_Space.cpu_name := CPU_Bindings.entries (I).cpu_name; end if; end loop; exit when is_last_element (Handler.Parsed_System.Address_Spaces, My_Iterator); next_element (Handler.Parsed_System.Address_Spaces, My_Iterator); end loop; end if; -- Check that no address space stays unbinded -- Bind threads, buffers and shared_resources -- if not is_empty (Handler.Parsed_System.Address_Spaces) then reset_iterator (Handler.Parsed_System.Address_Spaces, My_Iterator); loop current_element (Handler.Parsed_System.Address_Spaces, An_Address_Space, My_Iterator); -- Check and bind -- if An_Address_Space.cpu_name = Dummy_Identifier then Raise_Exception (AADL_Read_Error'Identity, "Process " & To_String (An_Address_Space.name) & " is not binded to a processor"); end if; if not is_empty (Handler.Parsed_System.Tasks) then reset_iterator (Handler.Parsed_System.Tasks, My_Task_Iterator); loop current_element (Handler.Parsed_System.Tasks, A_Task, My_Task_Iterator); if A_Task.address_space_name = An_Address_Space.name then A_Task.cpu_name := An_Address_Space.cpu_name; end if; exit when is_last_element (Handler.Parsed_System.Tasks, My_Task_Iterator); next_element (Handler.Parsed_System.Tasks, My_Task_Iterator); end loop; end if; if not is_empty (Handler.Parsed_System.Resources) then reset_iterator (Handler.Parsed_System.Resources, My_Resource_Iterator); loop current_element (Handler.Parsed_System.Resources, A_Resource, My_Resource_Iterator); if A_Resource.address_space_name = An_Address_Space.name then A_Resource.cpu_name := An_Address_Space.cpu_name; end if; exit when is_last_element (Handler.Parsed_System.Resources, My_Resource_Iterator); next_element (Handler.Parsed_System.Resources, My_Resource_Iterator); end loop; end if; if not is_empty (Handler.Parsed_System.Buffers) then reset_iterator (Handler.Parsed_System.Buffers, My_Buffer_Iterator); loop current_element (Handler.Parsed_System.Buffers, A_Buffer, My_Buffer_Iterator); if A_Buffer.address_space_name = An_Address_Space.name then A_Buffer.cpu_name := An_Address_Space.cpu_name; end if; exit when is_last_element (Handler.Parsed_System.Buffers, My_Buffer_Iterator); next_element (Handler.Parsed_System.Buffers, My_Buffer_Iterator); end loop; end if; exit when is_last_element (Handler.Parsed_System.Address_Spaces, My_Iterator); next_element (Handler.Parsed_System.Address_Spaces, My_Iterator); end loop; end if; -- Now, check that no task/resource/buffer stays unbinded -- if not is_empty (Handler.Parsed_System.Tasks) then reset_iterator (Handler.Parsed_System.Tasks, My_Task_Iterator); loop current_element (Handler.Parsed_System.Tasks, A_Task, My_Task_Iterator); if (A_Task.cpu_name = Dummy_Identifier) then Raise_Exception (AADL_Read_Error'Identity, "Task " & To_String (A_Task.name) & " is not binded to a processor"); end if; exit when is_last_element (Handler.Parsed_System.Tasks, My_Task_Iterator); next_element (Handler.Parsed_System.Tasks, My_Task_Iterator); end loop; end if; if not is_empty (Handler.Parsed_System.Resources) then reset_iterator (Handler.Parsed_System.Resources, My_Resource_Iterator); loop current_element (Handler.Parsed_System.Resources, A_Resource, My_Resource_Iterator); if (A_Resource.cpu_name = Dummy_Identifier) then Raise_Exception (AADL_Read_Error'Identity, "Data " & To_String (A_Resource.name) & " is not binded to a processor"); end if; exit when is_last_element (Handler.Parsed_System.Resources, My_Resource_Iterator); next_element (Handler.Parsed_System.Resources, My_Resource_Iterator); end loop; end if; if not is_empty (Handler.Parsed_System.Buffers) then reset_iterator (Handler.Parsed_System.Buffers, My_Buffer_Iterator); loop current_element (Handler.Parsed_System.Buffers, A_Buffer, My_Buffer_Iterator); if (A_Buffer.cpu_name = Dummy_Identifier) then Raise_Exception (AADL_Read_Error'Identity, "Buffer " & To_String (A_Buffer.name) & " is not binded to a processor"); end if; exit when is_last_element (Handler.Parsed_System.Buffers, My_Buffer_Iterator); next_element (Handler.Parsed_System.Buffers, My_Buffer_Iterator); end loop; end if; end Second_Pass; ------------------------------------------- --- Read AADL connections ------------------------------------------- procedure Read_Connections (Handler : in out AADL_Project_Parser; Component_Implementation : Node_Id; Component_Instance_Name : Unbounded_String; Path : Unbounded_String) is procedure Precedency_Connections (A_Connection : Node_Id) is Consumer_Thread_Name : Unbounded_String; Producer_Thread_Name : Unbounded_String; A_Consumer_Thread : Generic_Task_Ptr; A_Producer_Thread : Generic_Task_Ptr; -- A pair of index objects to keep track of the beginning and -- ending of the tokens isolated from the string: -- First : Natural; Last : Positive; -- A character set consisting of the "whitespace" characters -- that separate the tokens: -- Dot : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set ("."); Subname : Unbounded_String; begin -- Get thread names -- Producer_Thread_Name := to_lower (To_Unbounded_String (Image (Display_Name (Identifier (Source (A_Connection)))))); Consumer_Thread_Name := to_lower (To_Unbounded_String (Image (Display_Name (Identifier (Destination (A_Connection)))))); Subname := Producer_Thread_Name; Find_Token (Subname, Set => Dot, Test => Ada.Strings.Outside, First => First, Last => Last); Producer_Thread_Name := To_Unbounded_String (Slice (Subname, First, Last)); Producer_Thread_Name := Path & Component_Instance_Name & "." & Producer_Thread_Name; Subname := Consumer_Thread_Name; Find_Token (Subname, Set => Dot, Test => Ada.Strings.Outside, First => First, Last => Last); Consumer_Thread_Name := To_Unbounded_String (Slice (Subname, First, Last)); Consumer_Thread_Name := Path & Component_Instance_Name & "." & Consumer_Thread_Name; A_Consumer_Thread := Search_Task (Handler.Parsed_System.Tasks, Consumer_Thread_Name); A_Producer_Thread := Search_Task (Handler.Parsed_System.Tasks, Producer_Thread_Name); Add_One_Task_Dependency_precedence (Handler.Parsed_System.Dependencies, A_Consumer_Thread, A_Producer_Thread); end Precedency_Connections; procedure Buffer_Connections (A_Connection : Node_Id) is Buffer_Name : Unbounded_String; Consumer_Thread_Name : Unbounded_String; Producer_Thread_Name : Unbounded_String; A_Buffer : Buffer_Ptr; A_Consumer_Thread : Generic_Task_Ptr; Already_Exist : Boolean; A_Role : Buffer_Role; Roles : Buffer_Roles_Table; -- A pair of index objects to keep track of the beginning and -- ending of the tokens isolated from the string: -- First : Natural; Last : Positive; -- A character set consisting of the "whitespace" characters -- that separate the tokens: -- Dot : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set ("."); Subname : Unbounded_String; begin -- Get thread names -- Producer_Thread_Name := to_lower (To_Unbounded_String (Image (Display_Name (Identifier (Source (A_Connection)))))); Consumer_Thread_Name := to_lower (To_Unbounded_String (Image (Display_Name (Identifier (Destination (A_Connection)))))); Subname := Producer_Thread_Name; Find_Token (Subname, Set => Dot, Test => Ada.Strings.Outside, First => First, Last => Last); Producer_Thread_Name := To_Unbounded_String (Slice (Subname, First, Last)); Producer_Thread_Name := Path & Component_Instance_Name & "." & Producer_Thread_Name; Subname := Consumer_Thread_Name; Find_Token (Subname, Set => Dot, Test => Ada.Strings.Outside, First => First, Last => Last); Consumer_Thread_Name := To_Unbounded_String (Slice (Subname, First, Last)); Consumer_Thread_Name := Path & Component_Instance_Name & "." & Consumer_Thread_Name; A_Consumer_Thread := Search_Task (Handler.Parsed_System.Tasks, Consumer_Thread_Name); -- Is the buffer already exists ? -- if not, create it. If it already exist, add the new -- producer -- Buffer_Name := Consumer_Thread_Name & To_Unbounded_String ("_buffer"); begin Already_Exist := True; A_Buffer := Search_Buffer (Handler.Parsed_System.Buffers, Buffer_Name); exception when others => Already_Exist := False; end; if not Already_Exist then -- Create the buffer -- initialize (Roles); Initialize (A_Role); A_Role.the_role := queuing_Consumer; A_Role.size := 1; A_Role.time := 1; add (Roles, Consumer_Thread_Name, A_Role); Add_Buffer (Handler.Parsed_System.Buffers, A_Buffer, Buffer_Name, 1, A_Consumer_Thread.cpu_name, A_Consumer_Thread.address_space_name, Qs_Pp1, Roles); end if; -- Add the new role (producer) -- Initialize (A_Role); A_Role.the_role := queuing_Producer; A_Role.size := 1; A_Role.time := 1; add (A_Buffer.roles, Producer_Thread_Name, A_Role); end Buffer_Connections; procedure Shared_Resource_Connections (A_Connection : Node_Id) is Resource_Name : Unbounded_String; Thread_Name : Unbounded_String; Already_Exist : Boolean; Resource_Str_Ptr : unbounded_string_ptr; List_Ite : unbounded_string_iterator; A_Resource : Generic_Resource_Ptr; A_Thread : Generic_Task_Ptr; begin -- Check that no critical section are already memorized -- If we found no critical section, build a new one from -- the data access connection -- Resource_Name := to_lower (To_Unbounded_String (Image (Display_Name (Identifier (Source (A_Connection)))))); Resource_Name := Path & Component_Instance_Name & "." & Resource_Name; -- Get resource and thread information -- A_Resource := Search_Resource (Handler.Parsed_System.Resources, Resource_Name); Thread_Name := to_lower (To_Unbounded_String (Image (Display_Name (Identifier (Destination (A_Connection)))))); declare -- A pair of index objects to keep track of the beginning and -- ending of the tokens isolated from the string: -- First : Natural; Last : Positive; -- A character set consisting of the "whitespace" characters -- that separate the tokens: -- Dot : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set ("."); Subname : Unbounded_String; begin Subname := Thread_Name; Find_Token (Subname, Set => Dot, Test => Ada.Strings.Outside, First => First, Last => Last); Thread_Name := To_Unbounded_String (Slice (Subname, First, Last)); Thread_Name := Path & Component_Instance_Name & "." & Thread_Name; end; A_Thread := Search_Task (Handler.Parsed_System.Tasks, Thread_Name); -- Check is some critical section exists -- Already_Exist := False; if not is_empty (Critical_Section_List) then reset_head_iterator (Critical_Section_List, List_Ite); loop current_element (Critical_Section_List, Resource_Str_Ptr, List_Ite); if Resource_Str_Ptr.all = Resource_Name then Already_Exist := True; exit; end if; if is_tail_element (Critical_Section_List, List_Ite) then exit; end if; next_element (Critical_Section_List, List_Ite); end loop; end if; -- Add the critical section if the critical_section_list -- does not contain it -- if not Already_Exist then A_Resource.critical_sections.entries (A_Resource.critical_sections.nb_entries).item := Thread_Name; A_Resource.critical_sections.entries (A_Resource.critical_sections.nb_entries).data. task_begin := 1; A_Resource.critical_sections.entries (A_Resource.critical_sections.nb_entries).data. task_end := A_Thread.capacity; A_Resource.critical_sections.nb_entries := A_Resource.critical_sections.nb_entries + 1; end if; end Shared_Resource_Connections; List_Node : Node_Id; Cat : Connection_Type; begin if not Is_Empty (Ocarina.Nodes.Connections (Component_Implementation)) then List_Node := First_Node (Ocarina.Nodes.Connections (Component_Implementation)); while Present (List_Node) loop if Aadl_Debug then Print_Connection (List_Node, Default_Output_Options); end if; Cat := Get_Category_Of_Connection (List_Node); begin case Cat is when CT_Data | CT_Data_Delayed | CT_Access_Subprogram => null; when CT_Event => if Aadl_Import_Event_To_Buffers_Messages then Buffer_Connections (List_Node); end if; if Aadl_Import_Event_To_Precedencies then Precedency_Connections (List_Node); end if; when CT_Event_Data => if Aadl_Import_Event_Data_To_Buffers_Messages then Buffer_Connections (List_Node); end if; if Aadl_Import_Event_Data_To_Precedencies then Precedency_Connections (List_Node); end if; when CT_Port_Group => null; when CT_Parameter => null; when CT_Access_Bus => null; when CT_Access_Data => Shared_Resource_Connections (List_Node); end case; -- Sometimes, the parsing of a connection may fail. -- Most of the time, it means that the AADL component were not -- translated towards Cheddar's component (for several reasons) -- Then, we do not stop the parser : the AADL translation -- should continue ... -- exception when others => Put_Debug ("Warning : failed to parse an AADL connection"); Put_Debug(Exception_Name & " : " & Exception_Message); end; List_Node := Next_Node (List_Node); end loop; end if; end Read_Connections; procedure Third_Pass (Handler : in out AADL_Project_Parser; Root : Node_Id) is function Find_Subcomponents (Parent_Component : Node_Id; Identifier_Path : Unbounded_String; Level : Integer := 0) return Integer is List_Node : Node_Id; Component_Number : Integer := 0; Cat : Byte; Path : Unbounded_String := Identifier_Path; begin if Subcomponents (Parent_Component) /= No_List then List_Node := First_Node (Subcomponents (Parent_Component)); while List_Node /= No_Node loop Component_Number := Component_Number + 1; -- We look for the component type -- if Entity_Ref (List_Node) /= No_Node then -- Get the type of the component -- Cat := Category (List_Node); if Aadl_Debug then Put_Line ("Third pass ; Component name = " & To_String (Identifier_Path) & Get_Name_Of_Entity (List_Node)); Put_Line ("Third pass ; Component type = " & Get_Name_Of_Entity_Reference (Entity_Ref (List_Node))); end if; if Component_Category'Val (Cat) = CC_Process then Read_Property_Associations (Handler, Get_Referenced_Entity (Entity_Ref (List_Node)), to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Identifier_Path, 3); Read_Connections (Handler, Get_Referenced_Entity (Entity_Ref (List_Node)), to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Identifier_Path); end if; if Component_Category'Val (Cat) = CC_System then if Aadl_Import_With_System_Name then Path := to_lower (Identifier_Path & Get_Name_Of_Entity (List_Node) & ""); else Path := empty_string; end if; Read_Property_Associations (Handler, List_Node, to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Identifier_Path, 3); end if; if Component_Category'Val (Cat) = CC_System or else Component_Category'Val (Cat) = CC_Process then Component_Number := Component_Number + Find_Subcomponents (Get_Referenced_Entity (Entity_Ref (List_Node)), Path, Level + 1); end if; else -- The component has no type ... -- Currently, this is not supported -- Raise_Exception (AADL_Read_Error'Identity, "AADL component must have a type"); end if; List_Node := Next_Node (List_Node); end loop; end if; return Component_Number; end Find_Subcomponents; List_Node : Node_Id := No_Node; Global_Component_Number : Integer := 0; Path : Unbounded_String; begin Initialize_Parsed_Data; -- Find and perform analysis on all global systems -- if Ocarina.Nodes.Declarations (Root) /= No_List then List_Node := First_Node (Ocarina.Nodes.Declarations (Root)); while List_Node /= No_Node loop if Kind (List_Node) = K_Component_Implementation and then Component_Category'Val (Category (List_Node)) = CC_System then -- Read main system properties -- if Aadl_Import_With_System_Name then Path := to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node)) & "."); else Path := empty_string; end if; Read_Property_Associations (Handler, List_Node, to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node))), Path, 3); -- Find AADL sub components -- Global_Component_Number := Find_Subcomponents (List_Node, to_lower (To_Unbounded_String (Get_Name_Of_Entity (List_Node)) & ".")); end if; List_Node := Next_Node (List_Node); end loop; end if; end Third_Pass; ----------- -- Parse -- ----------- procedure Parse (Handler : in out AADL_Project_Parser; Dir_List : unbounded_string_list; Project_File_List : unbounded_string_list) is Root : Node_Id; Success : Boolean := False; A_Buff : Buffer_Ptr; My_Iterator_buffer : Buffers_Iterator; A_resource : generic_resource_Ptr; My_Iterator_resource : resources_Iterator; begin -- Ocarina Initialization -- Root := No_Node; if not First_AADL_Parsing then Ocarina.Configuration.Reset_Modules; Ocarina.Reset; else First_AADL_Parsing := False; end if; Ocarina.Initialize; Ocarina.Configuration.Init_Modules; -- Parse AADL property files -- Root := Load_AADL_File_From_Directory (Root, "AADL_Properties.aadl", Dir_List); Root := Load_AADL_File_From_Directory (Root, "AADL_Project.aadl", Dir_List); -- If the two files above have not been found, use those of -- Ocarina. -- Root := Ocarina.Parser.Parse_Standard_Property_Sets (Root); if No (Root) then Raise_Exception (AADL_Read_Error'Identity, "Cannot parse standard property sets"); end if; Root := Load_AADL_File_From_Directory (Root, "Cheddar_Properties.aadl", Dir_List); Root := Load_AADL_File_From_Directory (Root, "User_Defined_Cheddar_Properties.aadl", Dir_List); -- Read and Parse user files from Project_File_List -- declare A_File_Name : unbounded_string_ptr; List_Ite : unbounded_string_iterator; begin if not is_empty (Project_File_List) then reset_head_iterator (Project_File_List, List_Ite); loop current_element (Project_File_List, A_File_Name, List_Ite); Root := Load_AADL_File_From_Directory (Root, A_File_Name.all, Dir_List); if is_tail_element (Project_File_List, List_Ite) then exit; end if; next_element (Project_File_List, List_Ite); end loop; end if; end; -- Run AADL AST analysis -- if Root /= No_Node then Success := Ocarina.Analyzer.Analyze_Tree (Root, Default_Analyzer_Options); if not Success then Root := No_Node; end if; end if; -- Check that the AADL specification is OK -- if Root = No_Node then Raise_Exception (AADL_Read_Error'Identity, "Syntax error in the AADL specification"); else -- First pass : store subcomponents (systems, processor, -- thread and data components) -- initialize (Critical_Section_List); First_Pass (Handler, Root); if Aadl_Debug then Put_Line ("End of First pass"); end if; -- Second pass : perform processor and bus bindings -- if Aadl_Process_Second_Import_Pass then Second_Pass (Handler, Root); if Aadl_Debug then Put_Line ("End of Second pass"); end if; end if; -- Third pass : build components relationships (component -- connections) -- if Aadl_Process_Third_Import_Pass then -- Set shared resources critical section and task dependencies -- Third_Pass (Handler, Root); -- Build buffer's dependencies -- if not is_empty (Handler.Parsed_System.Buffers) then reset_iterator (Handler.Parsed_System.Buffers, My_Iterator_buffer); loop current_element (Handler.Parsed_System.Buffers, A_Buff, My_Iterator_buffer); begin Add_All_Task_Dependencies (Handler.Parsed_System.Dependencies, Handler.Parsed_System.Tasks, A_Buff); -- Sometimes, the parsing of a connection may fail. -- Most of the time, it means that the AADL -- components were not translated towards -- Cheddar's components (for several reasons). -- Then, we do not stop the parser : the AADL -- translation -- should continue ... -- exception when others => Put_Debug ("Warning : fail to translate an AADL " & "connection to a task dependency"); Put_Debug(Exception_Name & " : " & Exception_Message); end; exit when is_last_element (Handler.Parsed_System.Buffers, My_Iterator_buffer); next_element (Handler.Parsed_System.Buffers, My_Iterator_buffer); end loop; -- Check critical sections of shared resources -- and buffer roles -- if not is_empty (Handler.Parsed_System.Buffers) then reset_iterator (Handler.Parsed_System.Buffers, My_Iterator_buffer); loop current_element (Handler.Parsed_System.Buffers, A_Buff, My_Iterator_buffer); begin check_task_buffer_roles(Handler.Parsed_System.tasks, a_buff.name, a_buff.roles); -- Sometimes, the parsing of a connection may fail. -- Most of the time, it means that the AADL -- components were not translated towards -- Cheddar's components (for several reasons). -- Then, we do not stop the parser : the AADL -- translation -- should continue ... -- exception when others => Put_Debug ("Warning : fail to translate an AADL " & "connection to a buffer role "); Put_Debug(Exception_Name & " : " & Exception_Message); end; exit when is_last_element (Handler.Parsed_System.Buffers, My_Iterator_buffer); next_element (Handler.Parsed_System.Buffers, My_Iterator_buffer); end loop; end if; if not is_empty (Handler.Parsed_System.Resources) then reset_iterator (Handler.Parsed_System.Resources, My_Iterator_resource); loop current_element (Handler.Parsed_System.Resources, A_Resource, My_Iterator_resource); begin check_task_critical_sections(Handler.Parsed_System.tasks, a_resource.name, a_resource.cpu_name, a_resource.critical_sections); -- Sometimes, the parsing of a connection may fail. -- Most of the time, it means that the AADL -- components were not translated towards -- Cheddar's components (for several reasons). -- Then, we do not stop the parser : the AADL -- translation -- should continue ... -- exception when others => Put_Debug ("Warning : fail to translate an AADL " & "connection to a critical section "); Put_Debug(Exception_Name & " : " & Exception_Message); end; exit when is_last_element (Handler.Parsed_System.Resources, My_Iterator_resource); next_element (Handler.Parsed_System.Resources, My_Iterator_resource); end loop; end if; end if; -- Free memory -- -- Delete(Critical_Section_List); if Aadl_Debug then Put_Line ("End of Third pass"); end if; end if; end if; end Parse; end AADL_Parsers;