------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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-2016, Frank Singhoff, Alain Plantec, Jerome Legrand -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR 6285 laboratory, Université de Bretagne Occidentale -- -- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- ------------------------------------------------------------------------------ -- Last update : -- $Rev: 1249 $ -- $Date: 2014-08-28 07:02:15 +0200 (Fri, 28 Aug 2014) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Exceptions; use Ada.Exceptions; with Translate; use Translate; with Objects; use Objects; with Objects.extended; use Objects.extended; with unbounded_strings; use unbounded_strings; with initialize_framework; use initialize_framework; with Debug; use Debug; package body Buffer_Set is procedure Add_Buffer (My_Buffers : in out Buffers_Set; Name : in Unbounded_String; Size : in Integer; Cpu_Name : in Unbounded_String; Address_Space_Name : in Unbounded_String; A_Qs : in Queueing_Systems_Type; Roles : in Buffer_Roles_Table; Initial_Data : in Integer := 0) is Dummy : Buffer_Ptr; begin Add_Buffer (My_Buffers, Dummy, Name, Size, Cpu_Name, Address_Space_Name, A_Qs, Roles, Initial_Data); end Add_Buffer; procedure Check_Buffer (My_Buffers : in Buffers_Set; Name : in Unbounded_String; Size : in Integer; Cpu_Name : in Unbounded_String; Address_Space_Name : in Unbounded_String) is begin if (Name = "") then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Buffer_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_Buffer (Current_Language) & " " & Name & " : " & Lb_Buffer_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if (Cpu_Name = "") then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Buffer (Current_Language) & " " & Name & " : " & Lb_Processor_Name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if not Is_A_Valid_Identifier (cpu_Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_buffer (Current_Language) & " " & Name & " : " & Lb_processor_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if (Address_Space_Name = "") then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Buffer (Current_Language) & " " & Name & " : " & Lb_Address_Space_Name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if not Is_A_Valid_Identifier (address_space_Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_buffer (Current_Language) & " " & Name & " : " & Lb_address_space_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if (Size <= 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Buffer (Current_Language) & " " & Name & " : " & Lb_Size (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_than (Current_Language) & "0")); end if; end Check_Buffer; procedure Add_Buffer (My_Buffers : in out Buffers_Set; A_Buffer : in out Buffer_Ptr; Name : in Unbounded_String; Size : in Integer; Cpu_Name : in Unbounded_String; Address_Space_Name : in Unbounded_String; A_Qs : in Queueing_Systems_Type; Roles : in Buffer_Roles_Table; Initial_Data : in Integer := 0) is My_Iterator : iterator; begin Check_Initialize; Check_Buffer (My_Buffers, Name, Size, Cpu_Name, Address_Space_Name); if (get_number_of_elements (My_Buffers) > 0) then reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); if (Name = A_Buffer.name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Buffer (Current_Language) & " " & Name & " : " & Lb_Buffer_Name (Current_Language) & Lb_Already_Defined (Current_Language))); end if; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; end if; A_Buffer := new Buffer; A_Buffer.name := Name; A_Buffer.cpu_name := Cpu_Name; A_Buffer.address_space_name := Address_Space_Name; A_Buffer.buffer_size := Size; A_Buffer.roles := Roles; A_Buffer.queueing_system_type := A_Qs; A_Buffer.buffer_initial_data_size := Initial_Data; add (My_Buffers, A_Buffer); exception when full_set => Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Can_Not_Define_More_Buffers (Current_Language))); end Add_Buffer; procedure Update_Buffer (My_Buffers : in out Buffers_Set; Name : in Unbounded_String; New_Name : in Unbounded_String; Size : in Integer; Cpu_Name : in Unbounded_String; Address_Space_Name : in Unbounded_String; Roles : in Buffer_Roles_Table; Initial_Data : in Integer := 0) is The_Buffer : Buffer_Ptr; begin The_Buffer := Search_Buffer (My_Buffers, Name); The_Buffer.name := New_Name; The_Buffer.address_space_name := Address_Space_Name; The_Buffer.cpu_name := Cpu_Name; The_Buffer.buffer_size := Size; The_Buffer.roles := Roles; The_Buffer.buffer_initial_data_size := Initial_Data; end Update_Buffer; function Get (My_Buffers : in Buffers_Set; Buffer_Name : in Unbounded_String; Param_Name : in Buffer_Parameters) return Natural is A_Buffer : Buffer_Ptr; My_Iterator : iterator; begin if (Param_Name /= Size) then raise Invalid_Parameter; end if; reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); if (A_Buffer.name = Buffer_Name) then exit; end if; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; return A_Buffer.buffer_size; end Get; function Get (My_Buffers : in Buffers_Set; Buffer_Name : in Unbounded_String; Param_Name : in Buffer_Parameters) return Unbounded_String is A_Buffer : Buffer_Ptr; My_Iterator : iterator; begin if (Param_Name /= Cpu_Name) and (Param_Name /= Address_Space_Name) then raise Invalid_Parameter; end if; reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); if (A_Buffer.name = Buffer_Name) then exit; end if; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; if (Param_Name /= Cpu_Name) then return A_Buffer.cpu_name; else return A_Buffer.address_space_name; end if; end Get; procedure Set (My_Buffers : in out Buffers_Set; Buffer_Name : in Unbounded_String; Param_Name : in Buffer_Parameters; Param_Value : in Natural) is A_Buffer : Buffer_Ptr; My_Iterator : iterator; begin if (Param_Name /= Size) then raise Invalid_Parameter; end if; reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); if (A_Buffer.name = Buffer_Name) then A_Buffer.buffer_size := Param_Value; exit; end if; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; end Set; procedure Set (My_Buffers : in out Buffers_Set; Buffer_Name : in Unbounded_String; Param_Name : in Buffer_Parameters; Param_Value : in Unbounded_String) is A_Buffer : Buffer_Ptr; My_Iterator : iterator; begin if (Param_Name /= Cpu_Name) and (Param_Name /= Address_Space_Name) then raise Invalid_Parameter; end if; reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); if (A_Buffer.name = Buffer_Name) then if (Param_Name /= Cpu_Name) then A_Buffer.cpu_name := Param_Value; else A_Buffer.address_space_name := Param_Value; end if; exit; end if; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; end Set; function Search_Buffer_by_id (My_Buffers : in Buffers_Set; id : in Unbounded_String) return Buffer_Ptr is My_Iterator : iterator; A_Buffer : Buffer_Ptr; Result : Buffer_Ptr; Found : Boolean := False; begin if not is_empty(My_Buffers) then reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); if (A_Buffer.cheddar_private_id = id) then Found := True; Result := A_Buffer; end if; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; end if; if not Found then Raise_Exception (Buffer_Not_Found'Identity, To_String (lb_buffer_id (Current_Language) & "=" & id)); end if; return Result; end Search_Buffer_by_id; function Search_Buffer (My_Buffers : in Buffers_Set; Name : in Unbounded_String) return Buffer_Ptr is My_Iterator : iterator; A_Buffer : Buffer_Ptr; Result : Buffer_Ptr; Found : Boolean := False; begin if not is_empty(My_Buffers) then reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); if (A_Buffer.name = Name) then Found := True; Result := A_Buffer; end if; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; end if; if not Found then Raise_Exception (Buffer_Not_Found'Identity, To_String (Lb_Buffer_Name (Current_Language) & "=" & Name)); end if; return Result; end Search_Buffer; procedure Delete_Task (My_Buffers : in out Buffers_Set; A_Task : in Unbounded_String) is A_Buffer : Buffer_Ptr; My_Iterator : Buffers_Iterator; Nb_Entries : Buffer_Roles_Range; begin if (get_number_of_elements (My_Buffers) > 0) then reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); -- Looking for a_task in roles -- Nb_Entries := A_Buffer.roles.nb_entries; for Index in 0 .. Nb_Entries - 1 loop if (A_Buffer.roles.entries (Index).item = A_Task) then A_Buffer.roles.entries (Index) := A_Buffer.roles.entries (A_Buffer.roles.nb_entries - 1); A_Buffer.roles.nb_entries := A_Buffer.roles.nb_entries - 1; end if; end loop; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; end if; end Delete_Task; procedure Delete_Address_Space (My_Buffers : in out Buffers_Set; A_Addr : in Unbounded_String) is Tmp : Buffers_Set; A_Buffer : Buffer_Ptr; My_Iterator : Buffers_Iterator; begin if (get_number_of_elements (My_Buffers) > 0) then reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); if (A_Buffer.address_space_name = A_Addr) then add (Tmp, A_Buffer); end if; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; if not is_empty (Tmp) then reset_iterator (Tmp, My_Iterator); loop current_element (Tmp, A_Buffer, My_Iterator); delete (My_Buffers, A_Buffer); exit when is_last_element (Tmp, My_Iterator); next_element (Tmp, My_Iterator); end loop; end if; end if; end Delete_Address_Space; function Get_Number_Of_Buffer_From_Processor (My_Buffers : in Buffers_Set; Processor_Name : in Unbounded_String) return Buffers_Range is Number : Buffers_Range := 0; A_Buffer : Buffer_Ptr; My_Iterator : iterator; begin if is_empty (My_Buffers) then return 0; end if; reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); if (A_Buffer.cpu_name = Processor_Name) then Number := Number + 1; end if; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; return Number; end Get_Number_Of_Buffer_From_Processor; procedure Delete_Processor (My_Buffers : in out Buffers_Set; A_Processor : in Unbounded_String) is Tmp : Buffers_Set; A_Buffer : Buffer_Ptr; My_Iterator : Buffers_Iterator; begin if (get_number_of_elements (My_Buffers) > 0) then reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); if (A_Buffer.cpu_name = A_Processor) then add (Tmp, A_Buffer); end if; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; if not is_empty (Tmp) then reset_iterator (Tmp, My_Iterator); loop current_element (Tmp, A_Buffer, My_Iterator); delete (My_Buffers, A_Buffer); exit when is_last_element (Tmp, My_Iterator); next_element (Tmp, My_Iterator); end loop; reset (Tmp, False); end if; end if; end Delete_Processor; function Export_Aadl_Implementations (My_Buffers : in Buffers_Set) return Unbounded_String is Result : Unbounded_String := empty_string; begin return Result; end Export_Aadl_Implementations; procedure Check_entity_referencing_processor (My_buffers : in buffers_Set; A_processor : in Unbounded_String) is A_buffer :buffer_Ptr; My_Iterator : buffers_Iterator; begin if (get_number_of_elements (My_buffers) > 0) then reset_iterator (My_buffers, My_Iterator); loop current_element (My_buffers, A_buffer, My_Iterator); if (A_buffer.cpu_name = A_processor) then Raise_Exception (Invalid_Parameter'Identity, To_String ( lb_processor (Current_Language) & " " & a_processor & " : " & lb_buffer (Current_Language) & " " & a_buffer.Name & " : " & lb_entity_referenced_elsewhere(current_language) )); end if; exit when is_last_element (My_buffers, My_Iterator); next_element (My_buffers, My_Iterator); end loop; end if; end Check_entity_referencing_processor; procedure Check_entity_referencing_Address_Space (My_buffers : in buffers_Set; A_Addr : in Unbounded_String) is A_buffer :buffer_Ptr; My_Iterator : buffers_Iterator; begin if (get_number_of_elements (My_buffers) > 0) then reset_iterator (My_buffers, My_Iterator); loop current_element (My_buffers, A_buffer, My_Iterator); if (A_buffer.address_space_name = A_Addr) then Raise_Exception (Invalid_Parameter'Identity, To_String ( lb_address_space (Current_Language) & " " & a_addr & " : " & lb_buffer (Current_Language) & " " & a_buffer.Name & " : " & lb_entity_referenced_elsewhere(current_language) )); end if; exit when is_last_element (My_buffers, My_Iterator); next_element (My_buffers, My_Iterator); end loop; end if; end Check_entity_referencing_Address_Space; procedure Check_entity_referencing_task (My_buffers : in buffers_Set; A_task : in Unbounded_String) is A_buffer : buffer_Ptr; My_Iterator : buffers_Iterator; begin if (get_number_of_elements (My_buffers) > 0) then reset_iterator (My_buffers, My_Iterator); loop current_element (My_buffers, A_buffer, My_Iterator); for i in 0..a_buffer.roles.nb_entries -1 loop if a_buffer.roles.entries(i).item = a_task then Raise_Exception (Invalid_Parameter'Identity, To_String ( lb_task (Current_Language) & " " & a_task & " : " & lb_buffer (Current_Language) & " " & a_buffer.Name & " : " & lb_entity_referenced_elsewhere(current_language) )); end if; end loop; exit when is_last_element (My_buffers, My_Iterator); next_element (My_buffers, My_Iterator); end loop; end if; end Check_entity_referencing_task; end Buffer_Set;