------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 Ada.Exceptions; use Ada.Exceptions; with Processors; use Processors; 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 scheduler_interface.extended; use scheduler_interface.extended; 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 Integer; 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; l1_cache : in Unbounded_String := empty_string; start_time : in integer :=0) 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 not Is_A_Valid_Identifier (file_name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_core_unit (Current_Language) & " " & name & " , " & file_Name & " : " & Lb_Parametric_File_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) & Lb_greater_or_equal_than (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) & Lb_greater_or_equal_than (Current_Language) & To_Unbounded_String ("0"))); end if; if start_time < 0 then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & " " & Name & " : " & Lb_start_time (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (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) and (A_Scheduler = Hierarchical_cyclic_Protocol) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & Name & " : " & "Quantum" & Lb_Must_Be (Current_Language) & Lb_greater_than (Current_Language) & To_Unbounded_String ("0"))); 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) & Lb_greater_or_equal_than (Current_Language) & To_Unbounded_String ("0"))); end if; if (speed < 1) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & Name & " : " & lb_speed (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_than (Current_Language) & To_Unbounded_String ("0"))); end if; if (A_Scheduler = No_Scheduling_Protocol) or (A_Scheduler = user_defined_Protocol) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & " " & Name & " : " & Lb_Invalid_Scheduler (Current_Language))); end if; if not Is_A_Valid_Identifier (l1_cache) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_core_unit (Current_Language) & Name & " : " & lb_cache_name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (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 Integer; capacity : in Integer; period : in Integer; priority : in Integer; File_Name : in Unbounded_String; A_Scheduler : in Schedulers_Type; Mem : in Memories_Table; automaton_name : in Unbounded_String := empty_string; l1_cache : in Unbounded_String := empty_string; start_time : in integer :=0) 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, l1_cache, start_time); 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 core_unit; A_core_unit.name := To_Unbounded_String (To_String (Name)); A_core_unit.speed := speed; a_core_unit.l1_cache_system_name := l1_cache; a_core_unit.Memory_Partitions := mem; A_core_unit.scheduling.capacity := capacity; A_core_unit.scheduling.period := period; a_core_unit.scheduling.start_time := start_time; A_core_unit.scheduling.scheduler_type := a_scheduler; A_core_unit.scheduling.quantum:= quantum; A_core_unit.scheduling.preemptive_type := is_preemptive; A_core_unit.scheduling.priority := Priority_Range (priority); A_core_unit.scheduling.automaton_name:= automaton_name; a_core_unit.scheduling.user_defined_scheduler_source_file_name:= file_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 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 Integer; capacity : in Integer; period : in Integer; priority : in Integer; File_Name : in Unbounded_String; A_Scheduler : in Schedulers_Type; Mem : in Memories_Table; automaton_name : in Unbounded_String := empty_string; l1_cache : in Unbounded_String := empty_string; start_time : in integer :=0) 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, mem, automaton_name, l1_cache, start_time); end Add_core_unit; procedure Add_Processor (My_Processors : in out Processors_Set; A_Processor : in out Generic_Processor_Ptr; Name : in Unbounded_String; Cores : in Core_Units_Table; a_migration : migrations_type := job_level_migration_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, 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, Cores.entries (0)); else a_multi_cores_processor := new multi_cores_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 := name; 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; Cores : in Core_Units_Table; a_migration : migrations_type := job_level_migration_type; a_processor_type : processors_type := identical_multicores_type) is Dummy : Generic_Processor_Ptr; begin Add_Processor (My_Processors, Dummy, Name, 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_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_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_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 := name; 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_Core : in Core_Unit_Ptr) is Dummy : Generic_Processor_Ptr; begin Add_Processor (My_Processors, Dummy, Name, a_Core); end Add_Processor; 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 if not is_empty(My_core_units) then 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; end if; 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 if not is_empty(My_core_units) then 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; end if; 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 if not is_empty(My_Processors) then 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; end if; 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 Search_Processor_by_id (My_Processors : in Processors_Set; id : 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 if not is_empty(My_Processors) then reset_iterator (My_Processors, My_Iterator); loop current_element (My_Processors, A_Processor, My_Iterator); if (A_Processor.cheddar_private_id = id) 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; end if; if not Found then Raise_Exception (Processor_Not_Found'Identity, To_String (Lb_Processor_id (Current_Language) & "=" & id)); end if; return Result; end Search_Processor_by_id; function Processor_Is_Present (My_Processors : in Processors_Set; Name : in Unbounded_String) return Boolean is My_Iterator : Processors_Iterator; A_Processor : Generic_Processor_Ptr; Found : Boolean := False; begin if is_empty (My_Processors) then return False; else reset_iterator (My_Processors, My_Iterator); loop current_element (My_Processors, A_Processor, My_Iterator); if (A_Processor.name = Name) then Found := True; end if; exit when is_last_element (My_Processors, My_Iterator); next_element (My_Processors, My_Iterator); end loop; return Found; end if; end Processor_Is_Present; function Core_Is_Present (My_Cores : in core_units_Set; Name : in Unbounded_String) return Boolean is My_Iterator : core_units_Iterator; A_Core : Core_Unit_Ptr; Found : Boolean := False; begin if is_empty (My_Cores) then return False; else reset_iterator (My_Cores, My_Iterator); loop current_element (My_cores, A_Core, My_Iterator); if (A_Core.name = Name) then Found := True; end if; exit when is_last_element (My_Cores, My_Iterator); next_element (My_Cores, My_Iterator); end loop; return Found; end if; end Core_Is_Present; 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; 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 ( Mono_Core_Processor_Ptr (A_Processor).core.scheduling, 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_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; 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; for i in 0..cores.nb_entries-1 loop if (cores.entries(i).scheduling.scheduler_type = Hierarchical_Cyclic_Protocol) or (cores.entries(i).scheduling.scheduler_type = Hierarchical_Round_Robin_Protocol) or (cores.entries(i).scheduling.scheduler_type = Hierarchical_Fixed_Priority_Protocol) or (cores.entries(i).scheduling.scheduler_type = Hierarchical_Offline_Protocol) or (cores.entries(i).scheduling.scheduler_type = Hierarchical_Polling_Aperiodic_Server_Protocol) or (cores.entries(i).scheduling.scheduler_type = Hierarchical_Priority_Exchange_Aperiodic_Server_Protocol) or (cores.entries(i).scheduling.scheduler_type = Hierarchical_Sporadic_Aperiodic_Server_Protocol) or (cores.entries(i).scheduling.scheduler_type = Hierarchical_Deferrable_Aperiodic_Server_Protocol) then Raise_Exception (Invalid_Parameter'Identity, To_String (lb_processor (Current_Language) & Name & " : " & Lb_hierarchical_not_allowed(current_language) )); end if; end loop; end check_processor; procedure Check_entity_referencing_cache (My_cores : in core_units_Set; a_cache : in generic_cache_ptr) is A_core : core_unit_ptr; My_Iterator : core_units_Iterator; begin reset_iterator (my_cores, My_Iterator); if not is_empty (my_cores) then loop current_element (my_cores, A_core, My_Iterator); if (a_core.l1_cache_system_name = a_cache.name) then Raise_Exception (Invalid_Parameter'Identity, To_String ( lb_core_unit (Current_Language) & " " & a_core.Name & " : " & lb_cache (Current_Language) & " " & a_cache.name & " : " & lb_entity_referenced_elsewhere(current_language) )); end if; exit when is_last_element (my_cores, My_Iterator); next_element (my_cores, My_Iterator); end loop; end if; end Check_entity_referencing_cache; procedure Check_entity_referencing_cache (My_Processors : in Processors_Set; a_cache : in generic_cache_ptr) is A_Processor : Generic_Processor_Ptr; My_Iterator : Processors_Iterator; begin reset_iterator (my_Processors, My_Iterator); if not is_empty (my_Processors) then loop current_element (my_Processors, A_Processor, My_Iterator); if (a_processor.processor_type /= Monocore_type) then if (Multi_Cores_Processor_ptr(a_processor).l2_cache_system_name = a_cache.name) then Raise_Exception (Invalid_Parameter'Identity, To_String ( lb_processor (Current_Language) & " " & a_processor.Name & " : " & lb_cache (Current_Language) & " " & a_cache.name & " : " & lb_entity_referenced_elsewhere(current_language) )); end if; end if; exit when is_last_element (my_Processors, My_Iterator); next_element (my_Processors, My_Iterator); end loop; end if; end Check_entity_referencing_cache; procedure Check_entity_referencing_core_unit (My_Processors : in Processors_Set; a_core_unit : in core_unit_ptr) is A_Processor : Generic_Processor_Ptr; My_Iterator : Processors_Iterator; cannot_delete : boolean :=false; begin reset_iterator (my_Processors, My_Iterator); if not is_empty (my_Processors) then loop current_element (my_Processors, A_Processor, My_Iterator); cannot_delete:=false; if (a_processor.processor_type=monocore_type) then if (mono_core_processor_ptr(a_processor).core.name = a_core_unit.name) then cannot_delete:=true; end if; else for i in 0..multi_cores_processor_ptr(a_processor).cores.nb_entries-1 loop if (multi_cores_processor_ptr(a_processor).cores.entries(i).name = a_core_unit.name) then cannot_delete:=true; end if; end loop; end if; if (cannot_delete) then Raise_Exception (Invalid_Parameter'Identity, To_String ( lb_processor (Current_Language) & " " & a_processor.Name & " : " & lb_core_unit (Current_Language) & " " & a_core_unit.Name & " : " & lb_entity_referenced_elsewhere(current_language) )); end if; exit when is_last_element (my_Processors, My_Iterator); next_element (my_Processors, My_Iterator); end loop; end if; end Check_entity_referencing_core_unit; procedure Delete_core_unit (My_Processors : in Processors_Set; a_core_unit : core_unit_ptr) is A_Processor : Generic_Processor_Ptr; My_Iterator : Processors_Iterator; begin reset_iterator (my_Processors, My_Iterator); if not is_empty (my_Processors) then loop current_element (my_Processors, A_Processor, My_Iterator); if (a_processor.processor_type/=monocore_type) then for j in 0..multi_cores_processor_ptr(a_processor).cores.nb_entries-1 loop if A_core_unit.name = multi_cores_processor_ptr(a_processor).cores.entries(j).name then multi_cores_processor_ptr(a_processor).cores.entries(j):= multi_cores_processor_ptr(a_processor).cores.entries( (multi_cores_processor_ptr(a_processor).cores.nb_entries-1) ); multi_cores_processor_ptr(a_processor).cores.nb_entries:=multi_cores_processor_ptr(a_processor).cores.nb_entries-1; exit; end if; end loop; end if; exit when is_last_element (my_Processors, My_Iterator); next_element (my_Processors, My_Iterator); end loop; end if; end Delete_core_unit; end Processor_Set;