------------------------------------------------------------ -------------------- ------------------------------------------------------------------------------ -- 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 Translate; use Translate; with Objects; use Objects; with Objects.extended; use Objects.extended; with unbounded_strings; use unbounded_strings; 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) is Dummy : Buffer_Ptr; begin Add_Buffer (My_Buffers, Dummy, Name, Size, Cpu_Name, Address_Space_Name, A_Qs, Roles); 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 (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 (Size <= 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Buffer (Current_Language) & " " & Name & " : " & Lb_Size (Current_Language) & Lb_Must_Be (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) is My_Iterator : iterator; begin 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.size := Size; A_Buffer.roles := Roles; A_Buffer.queueing_system_type := A_Qs; 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) 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.size := Size; The_Buffer.roles := Roles; 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.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.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 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; 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 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; 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_Xml (My_Buffers : in Buffers_Set; Graphic_Properties_Flag : Boolean := True) return Unbounded_String is My_Iterator : Buffers_Iterator; A_Buffer : Buffer_Ptr; Result : Unbounded_String := empty_string; begin if not is_empty (My_Buffers) then Result := Result & To_Unbounded_String ("") & unbounded_lf; reset_iterator (My_Buffers, My_Iterator); loop current_element (My_Buffers, A_Buffer, My_Iterator); Result := Result & To_Unbounded_String (ASCII.HT & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & To_String (A_Buffer.cpu_name) & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & To_String (A_Buffer.address_space_name) & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & To_String (A_Buffer.name) & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & A_Buffer.size'Img & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & A_Buffer.queueing_system_type'Img & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "") & unbounded_lf; for I in 0 .. A_Buffer.roles.nb_entries - 1 loop Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & ASCII.HT & ""); else Result := Result & To_Unbounded_String (">"); end if; Result := Result & To_Unbounded_String (" " & To_String (A_Buffer.roles.entries (I).item) & " "); Result := Result & To_Unbounded_String (" " & A_Buffer.roles.entries (I).data.size'Img & " "); Result := Result & To_Unbounded_String (" " & A_Buffer.roles.entries (I).data.time'Img & " "); Result := Result & To_Unbounded_String ("") & unbounded_lf; end loop; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & "") & unbounded_lf; exit when is_last_element (My_Buffers, My_Iterator); next_element (My_Buffers, My_Iterator); end loop; Result := Result & To_Unbounded_String ("") & unbounded_lf; end if; return Result; end Export_Xml; 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; end Buffer_Set;