------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 Ada.Exceptions; use Ada.Exceptions; with Scheduler.user_defined; use Scheduler.user_defined; with Scheduler.user_defined.interpreted.pipeline; use Scheduler.user_defined.interpreted.pipeline; with Scheduler.user_defined.interpreted.Automata; use Scheduler.user_defined.interpreted.Automata; with Scheduler.user_defined.Generated.compiled; use Scheduler.user_defined.Generated.compiled; with Scheduler.Fixed_Priority.Dm; use Scheduler.Fixed_Priority.Dm; with Scheduler.Fixed_Priority.Rm; use Scheduler.Fixed_Priority.Rm; with Scheduler.Fixed_Priority.Hpf; use Scheduler.Fixed_Priority.Hpf; with Scheduler.Dynamic_Priority.Edf; use Scheduler.Dynamic_Priority.Edf; with Scheduler.Dynamic_Priority.Llf; use Scheduler.Dynamic_Priority.Llf; with Scheduler.Dynamic_Priority.Muf.Deadline_Based; use Scheduler.Dynamic_Priority.Muf.Deadline_Based; with Scheduler.Dynamic_Priority.Muf.Laxity_Based; use Scheduler.Dynamic_Priority.Muf.Laxity_Based; with Scheduler.Dynamic_Priority.D_Over; use Scheduler.Dynamic_Priority.D_Over; with Scheduler.Time_Sharing_Based_On_Wait_Time; use Scheduler.Time_Sharing_Based_On_Wait_Time; with Scheduler.Time_Sharing_Based_On_Cpu_Usage; use Scheduler.Time_Sharing_Based_On_Cpu_Usage; with Scheduler.Round_Robin; use Scheduler.Round_Robin; with Scheduler.Hierarchical; use Scheduler.Hierarchical; with Scheduler.Hierarchical.Round_Robin; use Scheduler.Hierarchical.Round_Robin; with Scheduler.Hierarchical.cyclic; use Scheduler.Hierarchical.cyclic; with Scheduler.Hierarchical.offline; use Scheduler.Hierarchical.offline; with Scheduler.Fixed_Priority.aperiodic_server; use Scheduler.Fixed_Priority.aperiodic_server; with Scheduler.Fixed_Priority.aperiodic_server.polling; use Scheduler.Fixed_Priority.aperiodic_server.polling; --with Scheduler.fixed_priority.aperiodic_server.priority_exchange; --use Scheduler.fixed_priority.aperiodic_server.priority_exchange; with Scheduler.Fixed_Priority.aperiodic_server.deferrable; use Scheduler.Fixed_Priority.aperiodic_server.deferrable; --with Scheduler.fixed_priority.aperiodic_server.sporadic; --use Scheduler.fixed_priority.aperiodic_server.sporadic; with Scheduler.multiprocessor_specific; use Scheduler.multiprocessor_specific; with Scheduler.multiprocessor_specific.pfair; use Scheduler.multiprocessor_specific.pfair; with Scheduler.multiprocessor_specific.pfair.PF; use Scheduler.multiprocessor_specific.pfair.PF; with Processors; use Processors; with Processors.extended; use Processors.extended; with core_units; use core_units; use core_units.Core_Units_Table_Package; with Translate; use Translate; with Objects; use Objects; with Objects.extended; use Objects.extended; with initialize_framework; use initialize_framework; with text_io; use text_io; package body Processor_Set is procedure Check_core_unit (Name : in Unbounded_String; Is_Preemptive : in Preemptives_Type; Quantum : in Integer; speed : in Double; capacity : in Integer; period : in Integer; priority : in Integer; File_Name : in Unbounded_String; A_Scheduler : in Schedulers_Type; automaton_name : in Unbounded_String := empty_string) is begin if (Name = "") then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit_name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if not Is_A_Valid_Identifier (Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & Name & " : " & lb_core_unit_name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if ( (A_Scheduler = pipeline_User_Defined_Protocol) or (A_Scheduler = Automata_User_Defined_Protocol) or (A_Scheduler = Hierarchical_offline_Protocol) ) and (File_Name = "") then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & Name & " : " & Lb_File_Name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if (File_Name /= "") and (A_Scheduler /= pipeline_User_Defined_Protocol) and (A_Scheduler /= Automata_User_Defined_Protocol) and (A_Scheduler /= Hierarchical_offline_Protocol) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & Name & " : " & Lb_File_Name_Control (Current_Language))); end if; if period < 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & " " & Name & " : " & Lb_Period (Current_Language) & Lb_Must_Be (Current_Language) & To_Unbounded_String (" >= 0"))); end if; if capacity < 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & " " & Name & " : " & Lb_Capacity (Current_Language) & Lb_Must_Be (Current_Language) & To_Unbounded_String (" >= 0"))); end if; if (priority < Integer (Priority_Range'First)) or (priority > Integer (Priority_Range'Last)) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & " " & Name & " : " & Lb_Invalid_Priority (Current_Language))); end if; if (Quantum /= 0) and (A_Scheduler /= Posix_1003_Highest_Priority_First_Protocol) and (A_Scheduler /= Round_Robin_Protocol) and (A_Scheduler /= Hierarchical_Round_Robin_Protocol) and (A_Scheduler /= Hierarchical_Cyclic_Protocol) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & Name & " : " & Lb_Quantum_Control (Current_Language))); end if; if (Quantum < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & Name & " : " & "Quantum" & Lb_Must_Be (Current_Language) & To_Unbounded_String (" >= 0"))); end if; if (speed < 0.0) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & Name & " : " & lb_speed (Current_Language) & Lb_Must_Be (Current_Language) & To_Unbounded_String (" >= 0"))); end if; if (A_Scheduler = No_Scheduling_Protocol) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & " " & Name & " : " & Lb_Invalid_Scheduler (Current_Language))); end if; end Check_core_unit; procedure Add_core_unit (My_core_units : in out core_units_Set; A_core_unit : in out Core_Unit_Ptr; Name : in Unbounded_String; Is_Preemptive : in Preemptives_Type; Quantum : in Integer; speed : in Double; capacity : in Integer; period : in Integer; priority : in Integer; File_Name : in Unbounded_String; A_Scheduler : in Schedulers_Type; automaton_name : in Unbounded_String := empty_string) is My_Iterator : core_units_Iterator; begin check_initialize; Check_core_unit (Name, Is_Preemptive, Quantum, speed, capacity, period, priority, File_Name, A_Scheduler, automaton_name); if (get_number_of_elements (My_core_units) > 0) then reset_iterator (My_core_units, My_Iterator); loop current_element (My_core_units, A_core_unit, My_Iterator); if (Name = A_core_unit.name) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & " " & Name & " : " & lb_core_unit_name (Current_Language) & Lb_Already_Defined (Current_Language))); end if; exit when is_last_element (My_core_units, My_Iterator); next_element (My_core_units, My_Iterator); end loop; end if; A_core_unit := new extended_core_unit; A_core_unit.name := To_Unbounded_String (To_String (Name)); set_core_unit_scheduler (extended_Core_Unit_Ptr (A_core_unit), Is_Preemptive, Quantum, speed, capacity, period, priority, File_Name, A_Scheduler, automaton_name); add (My_core_units, A_core_unit); exception when Generic_core_unit_Set.full_set => Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Can_Not_Define_More_core_units (Current_Language))); end Add_core_unit; procedure set_processor_scheduler (A_core_unit : in Core_Unit_Ptr; processor_name : in Unbounded_String) is a_scheduler : Generic_Scheduler_Ptr; begin a_scheduler := extended_Core_Unit_Ptr (A_core_unit).scheduler; a_scheduler.corresponding_processor := processor_name; end set_processor_scheduler; procedure set_core_unit_scheduler (A_core_unit : in extended_Core_Unit_Ptr; Is_Preemptive : in Preemptives_Type; Quantum : in Integer; speed : in Double; capacity : in Integer; period : in Integer; priority : in Integer; File_Name : in Unbounded_String; A_Scheduler : in Schedulers_Type; automaton_name : in Unbounded_String := empty_string) is begin case A_Scheduler is when Rate_Monotonic_Protocol => A_core_unit.scheduler := new Rm_Scheduler; when Deadline_Monotonic_Protocol => A_core_unit.scheduler := new Dm_Scheduler; when Posix_1003_Highest_Priority_First_Protocol => A_core_unit.scheduler := new Hpf_Scheduler; when Earliest_Deadline_First_Protocol => A_core_unit.scheduler := new Edf_Scheduler; when Least_Laxity_First_Protocol => A_core_unit.scheduler := new Llf_Scheduler; when Round_Robin_Protocol => A_core_unit.scheduler := new Round_Robin_Scheduler; when Maximum_Urgency_First_Based_On_Deadline_Protocol => A_core_unit.scheduler := new Deadline_Muf_Scheduler; when Maximum_Urgency_First_Based_On_Laxity_Protocol => A_core_unit.scheduler := new Laxity_Muf_Scheduler; when Time_Sharing_Based_On_Wait_Time_Protocol => A_core_unit.scheduler := new Time_Sharing_Based_On_Wait_Time_Scheduler; when Time_Sharing_Based_On_Cpu_Usage_Protocol => A_core_unit.scheduler := new Time_Sharing_Based_On_Cpu_Usage_Scheduler; when D_Over_Protocol => A_core_unit.scheduler := new D_Over_Scheduler; when pipeline_User_Defined_Protocol => A_core_unit.scheduler := new pipeline_user_defined_Scheduler; when Automata_User_Defined_Protocol => A_core_unit.scheduler := new Automata_User_Defined_Scheduler; when Compiled_User_Defined_Protocol => A_core_unit.scheduler := new compiled_user_defined_Scheduler; when Hierarchical_Cyclic_Protocol => A_core_unit.scheduler := new Hierarchical_cyclic_Scheduler; when Hierarchical_Offline_Protocol => A_core_unit.scheduler := new Hierarchical_offline_Scheduler; when Hierarchical_Round_Robin_Protocol => A_core_unit.scheduler := new Hierarchical_Round_Robin_Scheduler; when Hierarchical_Fixed_Priority_Protocol => A_core_unit.scheduler := new Rm_Scheduler; when hierarchical_polling_aperiodic_server_protocol => A_core_unit.scheduler := new polling_aperiodic_server_Scheduler; when hierarchical_deferrable_aperiodic_server_protocol => A_core_unit.scheduler := new deferrable_aperiodic_server_Scheduler; when hierarchical_priority_exchange_aperiodic_server_protocol => null; -- a_core_unit.Scheduler := new --hierarchical_priority_exchange_aperiodic_server_scheduler; when hierarchical_sporadic_aperiodic_server_protocol => null; -- a_core_unit.Scheduler := new --hierarchical_sporadic_aperiodic_server_scheduler; when Proportionate_Fair_PF_Protocol | Proportionate_Fair_PD_Protocol | Proportionate_Fair_PD2_Protocol => A_core_unit.scheduler := new multiprocessor_pfair_pf_Scheduler; when User_Defined_Protocol | No_Scheduling_Protocol => Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & " " & A_core_unit.name & " : " & Lb_Invalid_Scheduler (Current_Language))); end case; if (A_Scheduler = Automata_User_Defined_Protocol) then Set_Behavior_File_Name (Automata_User_Defined_Scheduler (A_core_unit.scheduler.all), File_Name); Set_Automaton_Name (Automata_User_Defined_Scheduler (A_core_unit.scheduler.all), automaton_name); end if; if (A_Scheduler = pipeline_User_Defined_Protocol) then Set_Behavior_File_Name (pipeline_user_defined_Scheduler (A_core_unit.scheduler.all), File_Name); end if; A_core_unit.speed := speed; A_core_unit.scheduler.corresponding_core_unit := A_core_unit.name; A_core_unit.scheduler.parameters.capacity := capacity; A_core_unit.scheduler.parameters.period := period; A_core_unit.scheduler.parameters.scheduler_type := a_scheduler; A_core_unit.scheduler.parameters.priority := Priority_Range (priority); Set_Quantum (A_core_unit.scheduler.all, Quantum); Set_Preemptive (A_core_unit.scheduler.all, Is_Preemptive); A_core_unit.scheduler.parameters.user_defined_scheduler_source_file_name:= file_name; A_core_unit.scheduler.parameters.automaton_name:= automaton_name; A_core_unit.scheduling := A_core_unit.scheduler.parameters; end set_core_unit_scheduler; procedure Add_core_unit (My_core_units : in out core_units_Set; Name : in Unbounded_String; Is_Preemptive : in Preemptives_Type; Quantum : in Integer; speed : in Double; capacity : in Integer; period : in Integer; priority : in Integer; File_Name : in Unbounded_String; A_Scheduler : in Schedulers_Type; automaton_name : in Unbounded_String := empty_string) is Dummy : Core_Unit_Ptr; begin Add_core_unit (My_core_units, Dummy, Name, Is_Preemptive, Quantum, speed, capacity, period, priority, File_Name, A_Scheduler, automaton_name); end Add_core_unit; procedure Add_Processor (My_Processors : in out Processors_Set; A_Processor : in out Generic_Processor_Ptr; Name : in Unbounded_String; A_Network : in Unbounded_String; Cores : in Core_Units_Table; a_migration : migrations_type := job_level_migration_type; --a_migration : migrations_type; a_processor_type : processors_type := identical_multicores_type) is My_Iterator : Processors_Iterator; a_multi_cores_processor : Multi_Cores_Processor_Ptr; begin check_initialize; Check_processor (My_Processors, Name, A_Network, Cores, a_migration, a_processor_type); if (get_number_of_elements (My_Processors) > 0) then reset_iterator (My_Processors, My_Iterator); loop current_element (My_Processors, A_Processor, My_Iterator); if (Name = A_Processor.name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Processor (Current_Language) & " " & Name & " : " & Lb_Processor_Name (Current_Language) & Lb_Already_Defined (Current_Language))); end if; exit when is_last_element (My_Processors, My_Iterator); next_element (My_Processors, My_Iterator); end loop; end if; if Cores.nb_entries = 1 then Add_Processor (My_Processors, A_Processor, Name, A_Network, Cores.entries (0)); else a_multi_cores_processor := new multi_cores_extended_Processor; a_multi_cores_processor.cores := Cores; a_multi_cores_processor.migration_type := a_migration; a_multi_cores_processor.processor_type := a_processor_type; A_Processor := Generic_Processor_Ptr (a_multi_cores_processor); A_Processor.name := To_Unbounded_String (To_String (Name)); A_Processor.network_name := A_Network; for i in 0 .. a_multi_cores_processor.cores.nb_entries - 1 loop set_processor_scheduler (a_multi_cores_processor.cores.entries (i), A_Processor.name); end loop; add (My_Processors, A_Processor); end if; exception when Generic_Processor_Set.full_set => Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Can_Not_Define_More_Processors (Current_Language))); end Add_Processor; procedure Add_Processor (My_Processors : in out Processors_Set; Name : in Unbounded_String; A_Network : in Unbounded_String; Cores : in Core_Units_Table; a_migration : migrations_type := job_level_migration_type; --a_migration : migrations_type; a_processor_type : processors_type := identical_multicores_type) is Dummy : Generic_Processor_Ptr; begin Add_Processor (My_Processors, Dummy, Name, A_Network, Cores, a_migration, a_processor_type); end Add_Processor; procedure Add_Processor (My_Processors : in out Processors_Set; A_Processor : in out Generic_Processor_Ptr; Name : in Unbounded_String; A_Network : in Unbounded_String; a_Core : in Core_Unit_Ptr) is My_Iterator : Processors_Iterator; a_mono_core_processor : Mono_Core_Processor_Ptr; begin check_initialize; Check_Processor (My_Processors, Name, A_Network, a_Core); if (get_number_of_elements (My_Processors) > 0) then reset_iterator (My_Processors, My_Iterator); loop current_element (My_Processors, A_Processor, My_Iterator); if (Name = A_Processor.name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Processor (Current_Language) & " " & Name & " : " & Lb_Processor_Name (Current_Language) & Lb_Already_Defined (Current_Language))); end if; exit when is_last_element (My_Processors, My_Iterator); next_element (My_Processors, My_Iterator); end loop; end if; a_mono_core_processor := new mono_core_extended_Processor; a_mono_core_processor.core := a_Core; a_mono_core_processor.processor_type := Monocore_type; A_Processor := Generic_Processor_Ptr (a_mono_core_processor); A_Processor.name := To_Unbounded_String (To_String (Name)); A_Processor.network_name := A_Network; add (My_Processors, A_Processor); exception when Generic_Processor_Set.full_set => Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Can_Not_Define_More_Processors (Current_Language))); end Add_Processor; procedure Add_Processor (My_Processors : in out Processors_Set; Name : in Unbounded_String; A_Network : in Unbounded_String; a_Core : in Core_Unit_Ptr) is Dummy : Generic_Processor_Ptr; begin Add_Processor (My_Processors, Dummy, Name, A_Network, a_Core); end Add_Processor; function Get (My_Processors : in Processors_Set; Processor_Name : in Unbounded_String; Param_Name : in Processor_Parameters) return Generic_Scheduler_Ptr is A_Processor : Generic_Processor_Ptr; My_Iterator : Processors_Iterator; begin if (Param_Name /= Scheduler) then raise Invalid_Parameter; end if; reset_iterator (My_Processors, My_Iterator); loop current_element (My_Processors, A_Processor, My_Iterator); if (A_Processor.name = Processor_Name) then exit; end if; exit when is_last_element (My_Processors, My_Iterator); next_element (My_Processors, My_Iterator); end loop; return extended_Core_Unit_Ptr (Mono_Core_Processor_Ptr (A_Processor).core). scheduler; end Get; procedure Set (My_Processors : in out Processors_Set; Processor_Name : in Unbounded_String; Param_Name : in Processor_Parameters; Param_Value : in Generic_Scheduler_Ptr) is A_Processor : Generic_Processor_Ptr; My_Iterator : Processors_Iterator; begin if (Param_Name /= Scheduler) then raise Invalid_Parameter; end if; reset_iterator (My_Processors, My_Iterator); loop current_element (My_Processors, A_Processor, My_Iterator); if (A_Processor.name = Processor_Name) then if A_Processor.processor_type = Monocore_type then extended_Core_Unit_Ptr ( Mono_Core_Processor_Ptr (A_Processor).core).scheduler := Param_Value; exit; end if; end if; exit when is_last_element (My_Processors, My_Iterator); next_element (My_Processors, My_Iterator); end loop; end Set; function Search_core_unit_by_id (My_core_units : in core_units_Set; id : in Unbounded_String) return Core_Unit_Ptr is My_Iterator : core_units_Iterator; A_core_unit : Core_Unit_Ptr; Result : Core_Unit_Ptr; Found : Boolean := False; begin reset_iterator (My_core_units, My_Iterator); loop current_element (My_core_units, A_core_unit, My_Iterator); if (A_core_unit.cheddar_private_id = id) then Found := True; Result := A_core_unit; end if; exit when is_last_element (My_core_units, My_Iterator); next_element (My_core_units, My_Iterator); end loop; if not Found then Raise_Exception (core_unit_Not_Found'Identity, To_String (lb_core_unit_id (Current_Language) & "=" & id)); end if; return Result; end Search_core_unit_by_id; function Search_core_unit (My_core_units : in core_units_Set; Name : in Unbounded_String) return Core_Unit_Ptr is My_Iterator : core_units_Iterator; A_core_unit : Core_Unit_Ptr; Result : Core_Unit_Ptr; Found : Boolean := False; begin reset_iterator (My_core_units, My_Iterator); loop current_element (My_core_units, A_core_unit, My_Iterator); if (A_core_unit.name = Name) then Found := True; Result := A_core_unit; end if; exit when is_last_element (My_core_units, My_Iterator); next_element (My_core_units, My_Iterator); end loop; if not Found then Raise_Exception (core_unit_Not_Found'Identity, To_String (lb_core_unit_name (Current_Language) & "=" & Name)); end if; return Result; end Search_core_unit; function Search_Processor (My_Processors : in Processors_Set; Name : in Unbounded_String) return Generic_Processor_Ptr is My_Iterator : Processors_Iterator; A_Processor : Generic_Processor_Ptr; Result : Generic_Processor_Ptr; Found : Boolean := False; begin reset_iterator (My_Processors, My_Iterator); loop current_element (My_Processors, A_Processor, My_Iterator); if (A_Processor.name = Name) then Found := True; Result := A_Processor; end if; exit when is_last_element (My_Processors, My_Iterator); next_element (My_Processors, My_Iterator); end loop; if not Found then Raise_Exception (Processor_Not_Found'Identity, To_String (Lb_Processor_Name (Current_Language) & "=" & Name)); end if; return Result; end Search_Processor; function Export_Aadl_Implementations (My_Processors : in Processors_Set) return Unbounded_String is My_Iterator : Processors_Iterator; A_Processor : Generic_Processor_Ptr; Result : Unbounded_String := empty_string; begin if not is_empty (My_Processors) then reset_iterator (My_Processors, My_Iterator); loop current_element (My_Processors, A_Processor, My_Iterator); Result := Result & To_Unbounded_String ("processor " & To_String (A_Processor.name)) & unbounded_lf; if A_Processor.network_name /= To_Unbounded_String ("No_Network") then Result := Result & To_Unbounded_String (ASCII.HT & "features") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "bus_connected : requires bus access " & To_String (A_Processor.network_name) & ";") & unbounded_lf; end if; Result := Result & To_Unbounded_String ("end " & To_String (A_Processor.name) & ";") & unbounded_lf & unbounded_lf; Result := Result & To_Unbounded_String ("processor implementation " & To_String (A_Processor.name) & ".Impl") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "properties ") & unbounded_lf; if A_Processor.processor_type = Monocore_type then Result := Result & Export_Aadl_Properties ( extended_Core_Unit_Ptr ( Mono_Core_Processor_Ptr (A_Processor).core).scheduler.all, 2); end if; Result := Result & To_Unbounded_String ("end " & To_String (A_Processor.name) & ".Impl;") & unbounded_lf & unbounded_lf; exit when is_last_element (My_Processors, My_Iterator); next_element (My_Processors, My_Iterator); end loop; end if; return Result; end Export_Aadl_Implementations; function Export_Aadl_Declarations (My_Processors : in Processors_Set; Number_Of_Ht : in Natural) return Unbounded_String is My_Iterator : Processors_Iterator; A_Processor : Generic_Processor_Ptr; Result : Unbounded_String := empty_string; begin if not is_empty (My_Processors) then reset_iterator (My_Processors, My_Iterator); loop current_element (My_Processors, A_Processor, My_Iterator); for I in 1 .. Number_Of_Ht loop Result := Result & ASCII.HT; end loop; Result := Result & To_Unbounded_String ("instancied_" & To_String (A_Processor.name) & " : processor " & To_String (A_Processor.name) & ".Impl;") & unbounded_lf; exit when is_last_element (My_Processors, My_Iterator); next_element (My_Processors, My_Iterator); end loop; end if; return Result; end Export_Aadl_Declarations; function build_core_table (a_processor : Generic_Processor_Ptr) return Core_Units_Table is the_cores : Core_Units_Table; begin if a_processor.processor_type = Monocore_type then the_cores.nb_entries := 1; the_cores.entries (0) := Mono_Core_Processor_Ptr (a_processor).core; else the_cores := Multi_Cores_Processor_Ptr (a_processor).cores; end if; return the_cores; end build_core_table; -- return a core from a processor (any of the core set) -- function get_a_core (a_processor : Generic_Processor_Ptr) return Core_Unit_ptr is begin if a_processor.processor_type = Monocore_type then return Mono_Core_Processor_Ptr (a_processor).core; else return Multi_Cores_Processor_Ptr (a_processor).cores.entries(0); end if; end get_a_core; -- Check a monocore processor -- procedure Check_Processor (My_Processors : in Processors_Set; Name : in Unbounded_String; A_Network : in Unbounded_String; a_Core : in Core_Unit_Ptr) is begin if (Name = "") then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_processor_name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if not Is_A_Valid_Identifier (Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_processor (Current_Language) & Name & " : " & lb_processor_name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if a_core = null then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_processor (Current_Language) & Name & " : " & lb_core_unit (Current_Language) & Lb_Mandatory (Current_Language))); end if; end check_processor; -- Check a multicore processor -- procedure Check_processor (My_Processors : in Processors_Set; Name : in Unbounded_String; A_Network : in Unbounded_String; Cores : in Core_Units_Table; a_migration : migrations_type; a_processor_type : processors_type) is first_core : core_unit_ptr; begin if (Name = "") then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_processor_name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if not Is_A_Valid_Identifier (Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_processor (Current_Language) & Name & " : " & lb_processor_name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if cores.nb_entries <= 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_processor (Current_Language) & Name & " : " & lb_core_unit (Current_Language) & Lb_Mandatory (Current_Language))); end if; first_core:=cores.entries(0); for i in 0..cores.nb_entries-1 loop if (first_core.scheduling.scheduler_type/= cores.entries(i).scheduling.scheduler_type) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_processor (Current_Language) & Name & " : " & Lb_core_with_same_scheduler(current_language) )); end if; end loop; end check_processor; end Processor_Set;