------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 Time_Unit_Events; use Time_Unit_Events; use Time_Unit_Events.Time_Unit_Package; with double_util; use double_util; with unbounded_strings; use unbounded_strings; with translate; use translate; package body Message_Set is procedure Add_Message (My_Messages : in out Messages_Set; Name : in Unbounded_String; Size : in Natural; Period : in Natural; Deadline : in Natural; Jitter : in Natural; Param : in User_Defined_Parameters_Table := No_User_Defined_Parameter; Response_Time : in Natural; Communication_Time : in Natural) is Dummy : Generic_Message_Ptr; begin Add_Message (My_Messages, Dummy, Name, Size, Period, Deadline, Jitter, Param, Response_Time, Communication_Time); end Add_Message; procedure Check_Message (My_Messages : in Messages_Set; Name : in Unbounded_String; Size : in Natural; Period : in Natural; Deadline : in Natural; Jitter : in Natural; Param : in User_Defined_Parameters_Table := No_User_Defined_Parameter; Response_Time : in Natural; Communication_Time : in Natural) is My_Iterator : iterator; A_Message : Generic_Message_Ptr; begin if (Name = "") then raise Invalid_Parameter; end if; if (Size = 0) then raise Invalid_Parameter; end if; if (Jitter > Deadline) then raise Invalid_Parameter; end if; if (get_number_of_elements (My_Messages) > 0) then reset_iterator (My_Messages, My_Iterator); loop current_element (My_Messages, A_Message, My_Iterator); if (Name = A_Message.name) then raise Message_Already_Defined; end if; exit when is_last_element (My_Messages, My_Iterator); next_element (My_Messages, My_Iterator); end loop; end if; end Check_Message; procedure Add_Message (My_Messages : in out Messages_Set; A_Message : in out Generic_Message_Ptr; Name : in Unbounded_String; Size : in Natural; Period : in Natural; Deadline : in Natural; Jitter : in Natural; Param : in User_Defined_Parameters_Table := No_User_Defined_Parameter; Response_Time : in Natural; Communication_Time : in Natural) is New_Periodic_Message : Periodic_Message_Ptr; New_Aperiodic_Message : Aperiodic_Message_Ptr; begin Check_Message (My_Messages, Name, Size, Period, Deadline, Jitter, Param, Response_Time, Communication_Time); if (Period /= 0) then New_Periodic_Message := new Periodic_Message; New_Periodic_Message.jitter := Jitter; New_Periodic_Message.period := Period; A_Message := Generic_Message_Ptr (New_Periodic_Message); else New_Aperiodic_Message := new Aperiodic_Message; A_Message := Generic_Message_Ptr (New_Aperiodic_Message); end if; A_Message.name := Name; A_Message.size := Size; A_Message.response_time := Response_Time; A_Message.communication_time := Communication_Time; A_Message.deadline := Deadline; A_Message.parameters := Param; add (My_Messages, A_Message); end Add_Message; procedure Update_Message (My_Messages : in out Messages_Set; Name : in Unbounded_String; New_Name : in Unbounded_String; Size : in Natural; Period : in Natural; Deadline : in Natural; Jitter : in Natural; Param : in User_Defined_Parameters_Table := No_User_Defined_Parameter; Response_Time : in Natural; Communication_Time : in Natural) is A_Message : Generic_Message_Ptr; A_Periodic_Message : Periodic_Message_Ptr; begin A_Message := Search_Message (My_Messages, Name); A_Message.name := New_Name; A_Message.size := Size; A_Message.deadline := Deadline; A_Message.parameters := Param; A_Message.response_time := Response_Time; A_Message.communication_time := Communication_Time; if (A_Message.message_type = Periodic_Type) then A_Periodic_Message := Periodic_Message_Ptr (A_Message); A_Periodic_Message.period := Period; A_Periodic_Message.jitter := Jitter; end if; end Update_Message; function Have_Deadlines_Equal_Than_Periods (My_Messages : in Messages_Set) return Boolean is Equal_Than : Boolean := True; A_Message : Generic_Message_Ptr; My_Iterator : iterator; begin reset_iterator (My_Messages, My_Iterator); loop current_element (My_Messages, A_Message, My_Iterator); if (A_Message.message_type /= Periodic_Type) then return False; end if; if (Periodic_Message_Ptr (A_Message).deadline = Periodic_Message_Ptr (A_Message).period) then Equal_Than := False; end if; exit when is_last_element (My_Messages, My_Iterator); next_element (My_Messages, My_Iterator); end loop; return Equal_Than; end Have_Deadlines_Equal_Than_Periods; procedure Get_Global_Message_Type (My_Messages : in Messages_Set; Has_Global_Type : out Boolean; Global_Type : out Messages_Type) is A_Message : Generic_Message_Ptr; My_Iterator : iterator; begin Has_Global_Type := True; reset_iterator (My_Messages, My_Iterator); -- Find the first message of the processor -- current_element (My_Messages, A_Message, My_Iterator); Global_Type := A_Message.message_type; if is_last_element (My_Messages, My_Iterator) then return; else next_element (My_Messages, My_Iterator); end if; loop current_element (My_Messages, A_Message, My_Iterator); if (Global_Type /= A_Message.message_type) then Has_Global_Type := False; return; end if; exit when is_last_element (My_Messages, My_Iterator); next_element (My_Messages, My_Iterator); end loop; end Get_Global_Message_Type; function Search_Message_by_id (My_Messages : in Messages_Set; id : in Unbounded_String) return Generic_Message_Ptr is My_Iterator : iterator; A_Message : Generic_Message_Ptr; Result : Generic_Message_Ptr; Found : Boolean := False; begin reset_iterator (My_Messages, My_Iterator); loop current_element (My_Messages, A_Message, My_Iterator); if (A_Message.cheddar_private_id = id) then Found := True; Result := A_Message; end if; exit when is_last_element (My_Messages, My_Iterator); next_element (My_Messages, My_Iterator); end loop; if not Found then Raise_Exception (message_Not_Found'Identity, To_String (lb_message_id (Current_Language) & "=" & id)); end if; return Result; end Search_Message_by_id; function Search_Message (My_Messages : in Messages_Set; Name : in Unbounded_String) return Generic_Message_Ptr is My_Iterator : iterator; A_Message : Generic_Message_Ptr; Result : Generic_Message_Ptr; Found : Boolean := False; begin reset_iterator (My_Messages, My_Iterator); loop current_element (My_Messages, A_Message, My_Iterator); if (A_Message.name = Name) then Found := True; Result := A_Message; end if; exit when is_last_element (My_Messages, My_Iterator); next_element (My_Messages, My_Iterator); end loop; if not Found then raise Message_Not_Found; end if; return Result; end Search_Message; function Increasing_Period (Op1 : in Generic_Message_Ptr; Op2 : in Generic_Message_Ptr) return Boolean is begin return (Periodic_Message_Ptr (Op1).period <= Periodic_Message_Ptr (Op2).period); end Increasing_Period; function Decreasing_Period (Op1 : in Generic_Message_Ptr; Op2 : in Generic_Message_Ptr) return Boolean is begin return (Periodic_Message_Ptr (Op1).period >= Periodic_Message_Ptr (Op2).period); end Decreasing_Period; function Increasing_Deadline (Op1 : in Generic_Message_Ptr; Op2 : in Generic_Message_Ptr) return Boolean is begin return (Periodic_Message_Ptr (Op1).deadline <= Periodic_Message_Ptr (Op2).deadline); end Increasing_Deadline; function Decreasing_Deadline (Op1 : in Generic_Message_Ptr; Op2 : in Generic_Message_Ptr) return Boolean is begin return (Periodic_Message_Ptr (Op1).deadline >= Periodic_Message_Ptr (Op2).deadline); end Decreasing_Deadline; function Get (My_Messages : in Messages_Set; Message_Name : in Unbounded_String; Param_Name : in Message_Parameters) return Natural is A_Message : Generic_Message_Ptr; My_Iterator : iterator; begin if ((Param_Name /= Size) and (Param_Name /= Period) and (Param_Name /= Deadline) and (Param_Name /= Response_Time) and (Param_Name /= Jitter)) then raise Invalid_Parameter; end if; reset_iterator (My_Messages, My_Iterator); loop current_element (My_Messages, A_Message, My_Iterator); if (A_Message.name = Message_Name) then exit; end if; exit when is_last_element (My_Messages, My_Iterator); next_element (My_Messages, My_Iterator); end loop; if (Param_Name = Size) then return A_Message.size; else if (Param_Name = Deadline) then return Periodic_Message_Ptr (A_Message).deadline; else if (Param_Name = Response_Time) then return A_Message.response_time; else if (Param_Name = Communication_Time) then return A_Message.communication_time; else if (Param_Name = Period) then return Periodic_Message_Ptr (A_Message).period; else return Periodic_Message_Ptr (A_Message).jitter; end if; end if; end if; end if; end if; end Get; procedure Set (My_Messages : in out Messages_Set; Message_Name : in Unbounded_String; Param_Name : in Message_Parameters; Param_Value : in Natural) is A_Message : Generic_Message_Ptr; My_Iterator : iterator; begin if ((Param_Name /= Size) and (Param_Name /= Period) and (Param_Name /= Deadline) and (Param_Name /= Jitter)) and (Param_Name /= Response_Time) and (Param_Name /= Communication_Time) then raise Invalid_Parameter; end if; reset_iterator (My_Messages, My_Iterator); loop current_element (My_Messages, A_Message, My_Iterator); if (A_Message.name = Message_Name) then if (Param_Name = Size) then A_Message.size := Param_Value; else if (Param_Name = Response_Time) then A_Message.response_time := Param_Value; else if (Param_Name = Communication_Time) then A_Message.communication_time := Param_Value; exit; end if; end if; end if; end if; if (Param_Name = Deadline) then Periodic_Message_Ptr (A_Message).deadline := Param_Value; end if; if (Param_Name = Period) then Periodic_Message_Ptr (A_Message).period := Param_Value; exit; end if; if (Param_Name = Jitter) then Periodic_Message_Ptr (A_Message).jitter := Param_Value; exit; end if; exit when is_last_element (My_Messages, My_Iterator); next_element (My_Messages, My_Iterator); end loop; end Set; function Export_Xml (My_Messages : in Messages_Set; Graphic_Properties_Flag : Boolean := True) return Unbounded_String is My_Iterator : Messages_Iterator; A_Message : Generic_Message_Ptr; Result : Unbounded_String := empty_string; begin if not is_empty (My_Messages) then Result := Result & To_Unbounded_String ("") & unbounded_lf; reset_iterator (My_Messages, My_Iterator); loop current_element (My_Messages, A_Message, My_Iterator); Result := Result & To_Unbounded_String (ASCII.HT & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & To_String (A_Message.name) & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & A_Message.size'Img & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & A_Message.deadline'Img & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & A_Message.response_time'Img & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & A_Message.communication_time'Img & "") & unbounded_lf; if (A_Message.message_type = Periodic_Type) then Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & Periodic_Message_Ptr (A_Message).period'Img & "") & unbounded_lf; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "" & Periodic_Message_Ptr (A_Message).jitter'Img & "") & unbounded_lf; end if; if A_Message.parameters.nb_entries > 0 then Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "") & unbounded_lf; for I in 0 .. A_Message.parameters.nb_entries - 1 loop Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & ASCII.HT & " "); Result := Result & To_Unbounded_String (" " & A_Message.parameters.entries (I).boolean_value' Img & " "); else if A_Message.parameters.entries (I).discriminant = Integer_Parameter then Result := Result & To_Unbounded_String (" parameter_type=""integer""> "); Result := Result & To_Unbounded_String (" " & A_Message.parameters.entries (I). integer_value'Img & " "); else if A_Message.parameters.entries (I).discriminant = Double_Parameter then Result := Result & To_Unbounded_String (" parameter_type=""double""> "); Result := Result & To_Unbounded_String (" " & To_String (format (A_Message.parameters.entries (I). double_value)) & " "); else Result := Result & To_Unbounded_String (" parameter_type=""string""> "); Result := Result & To_Unbounded_String (" " & To_String (A_Message.parameters.entries (I).string_value) & " "); end if; end if; end if; Result := Result & To_Unbounded_String (To_String (" " & A_Message.parameters.entries (I).name) & " "); Result := Result & To_Unbounded_String ("") & unbounded_lf; end loop; Result := Result & To_Unbounded_String (ASCII.HT & ASCII.HT & "") & unbounded_lf; end if; Result := Result & To_Unbounded_String (ASCII.HT & "") & unbounded_lf; exit when is_last_element (My_Messages, My_Iterator); next_element (My_Messages, My_Iterator); end loop; Result := Result & To_Unbounded_String ("") & unbounded_lf; end if; return Result; end Export_Xml; function Export_Aadl_User_Defined_Properties (My_Messages : in Messages_Set) return Unbounded_String is Result : Unbounded_String := empty_string; begin return Result; end Export_Aadl_User_Defined_Properties; function Export_Aadl_Implementations (My_Messages : in Messages_Set) return Unbounded_String is Result : Unbounded_String := empty_string; begin return Result; end Export_Aadl_Implementations; end Message_Set;