------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 6285, 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$ -- $Date$ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; with unbounded_strings; use unbounded_strings; package body Simulations.Extended is function To_Unbounded_String (S : in Simulation_Value_Ptr; From, To : in Natural) return Unbounded_String is Msg : Unbounded_String := empty_string; Safe_From : Natural := 0; Safe_To : Natural := 0; begin if (S /= null) then if (S.Ptype = Simulation_Random) or (S.Ptype = Simulation_Array_Random) then return empty_string; end if; if ((S.Ptype = Simulation_Time_Unit_Array_Boolean) or (S.Ptype = Simulation_Time_Unit_Array_Integer) or (S.Ptype = Simulation_Time_Unit_Array_Double) or (S.Ptype = Simulation_Time_Unit_Array_String)) then if Integer (Time_Unit_Range'First) <= Integer (From) then Safe_From := From; else Safe_From := Natural (Time_Unit_Range'First); end if; if Integer (Time_Unit_Range'Last) >= To then Safe_To := To; else Safe_To := Natural (Time_Unit_Range'Last); end if; end if; if ((S.Ptype = Simulation_Array_Boolean) or (S.Ptype = Simulation_Array_Integer) or (S.Ptype = Simulation_Array_String) or (S.Ptype = Simulation_array_clock) or (S.Ptype = Simulation_Array_Double)) then if Integer (Simulations_Range'First) <= Integer (From) then Safe_From := From; else Safe_From := Natural (Simulations_Range'First); end if; if Integer (Simulations_Range'Last) >= To then Safe_To := To; else Safe_To := Natural (Simulations_Range'Last); end if; end if; case S.Ptype is when Simulation_Random => null; when Simulation_Array_Random => null; when Simulation_Integer | Simulation_clock => return To_Unbounded_String (S.Integer_Value'Img); when Simulation_Boolean => return To_Unbounded_String (S.Boolean_Value'Img); when Simulation_Double => return To_Unbounded_String (S.Double_Value'Img); when Simulation_String => return S.String_Value; when Simulation_Time_Unit_Array_Boolean => for I in Time_Unit_Range loop if (Natural (I) >= Safe_From) and (Natural (I) <= Safe_To) then Msg := Msg & S.boolean_Time_Unit_Table_Value (I)'Img & ' '; end if; end loop; when Simulation_Time_Unit_Array_Integer => for I in Time_Unit_Range loop if (Natural (I) >= Safe_From) and (Natural (I) <= Safe_To) then Msg := Msg & S.Integer_Time_Unit_Table_Value (I)'Img & ' '; end if; end loop; when Simulation_Time_Unit_Array_Double => for I in Time_Unit_Range loop if (Natural (I) >= Safe_From) and (Natural (I) <= Safe_To) then Msg := Msg & S.Double_Time_Unit_Table_Value (I)'Img & ' '; end if; end loop; when Simulation_Time_Unit_Array_String => for I in Time_Unit_Range loop if (Natural (I) >= Safe_From) and (Natural (I) <= Safe_To) then Msg := Msg & S.String_Time_Unit_Table_Value (I) & ' '; end if; end loop; when Simulation_Array_Boolean => for I in Simulations_Range loop if (Natural (I) >= Safe_From) and (Natural (I) <= Safe_To) then Msg := Msg & S.Boolean_Table_Value (I)'Img & ' '; end if; end loop; when Simulation_Array_Integer | Simulation_array_clock => for I in Simulations_Range loop if (Natural (I) >= Safe_From) and (Natural (I) <= Safe_To) then Msg := Msg & S.Integer_Table_Value (I)'Img & ' '; end if; end loop; when Simulation_Array_Double => for I in Simulations_Range loop if (Natural (I) >= Safe_From) and (Natural (I) <= Safe_To) then Msg := Msg & S.Double_Table_Value (I)'Img & ' '; end if; end loop; when Simulation_Array_String => for I in Simulations_Range loop if (Natural (I) >= Safe_From) and (Natural (I) <= Safe_To) then Msg := Msg & S.String_Table_Value (I) & ' '; end if; end loop; end case; end if; return Msg; end To_Unbounded_String; function To_Unbounded_String (S : Simulation_Value_Ptr) return Unbounded_String is begin return To_Unbounded_String (S, 0, 0); end To_Unbounded_String; procedure Put (S : Simulation_Value_Ptr) is begin Put (To_Unbounded_String (S)); end Put; function Copy (My_Simulation : in Simulation_Value_Ptr) return Simulation_Value_Ptr is New_Simulation : Simulation_Value_Ptr; begin New_Simulation := new Simulation_Value (My_Simulation.Ptype); case My_Simulation.Ptype is when Simulation_Random => New_Simulation.Random_Value := My_Simulation.Random_Value; when Simulation_Boolean => New_Simulation.Boolean_Value := My_Simulation.Boolean_Value; when Simulation_Integer | Simulation_clock => New_Simulation.Integer_Value := My_Simulation.Integer_Value; when Simulation_Double => New_Simulation.Double_Value := My_Simulation.Double_Value; when Simulation_String => New_Simulation.String_Value := My_Simulation.String_Value; when Simulation_Array_Boolean => New_Simulation.Boolean_Table_Value := My_Simulation.Boolean_Table_Value; when Simulation_Array_Integer | Simulation_array_clock => New_Simulation.Integer_Table_Value := My_Simulation.Integer_Table_Value; when Simulation_Array_Double => New_Simulation.Double_Table_Value := My_Simulation.Double_Table_Value; when Simulation_Array_String => New_Simulation.String_Table_Value := My_Simulation.String_Table_Value; when Simulation_Array_Random => New_Simulation.Random_Table_Value := My_Simulation.Random_Table_Value; when Simulation_Time_Unit_Array_Boolean => New_Simulation.boolean_Time_Unit_Table_Value := My_Simulation.boolean_Time_Unit_Table_Value; when Simulation_Time_Unit_Array_Integer => New_Simulation.Integer_Time_Unit_Table_Value := My_Simulation.Integer_Time_Unit_Table_Value; when Simulation_Time_Unit_Array_Double => New_Simulation.Double_Time_Unit_Table_Value := My_Simulation.Double_Time_Unit_Table_Value; when Simulation_Time_Unit_Array_String => New_Simulation.String_Time_Unit_Table_Value := My_Simulation.String_Time_Unit_Table_Value; end case; return New_Simulation; end Copy; function has_compatible_type (a : in Simulation_Type; b : in Simulation_Type) return Boolean is Ok : Boolean := False; procedure Reversable_Check (A : in Simulation_Type; B : in Simulation_Type) is begin -- Same type : it's ok -- if A = B then Ok := True; end if; -- integer and clock types are compatibles -- if A = Simulation_clock and B = Simulation_Integer then Ok := True; end if; if A = Simulation_array_clock and B = Simulation_Array_Integer then Ok := True; end if; -- An array variable can be initialized with a constant -- of the same type -- if A = Simulation_clock and B = Simulation_array_clock then Ok := True; end if; if A = Simulation_Integer and B = Simulation_Array_Integer then Ok := True; end if; if A = Simulation_String and B = Simulation_Array_String then Ok := True; end if; if A = Simulation_Random and B = Simulation_Array_Random then Ok := True; end if; if A = Simulation_Boolean and B = Simulation_Array_Boolean then Ok := True; end if; if A = Simulation_Double and B = Simulation_Array_Double then Ok := True; end if; if A = Simulation_Time_Unit_Array_Integer and B = Simulation_Array_Integer then Ok := True; end if; if A = Simulation_Time_Unit_Array_String and B = Simulation_Array_String then Ok := True; end if; if A = Simulation_Time_Unit_Array_Boolean and B = Simulation_Array_Boolean then Ok := True; end if; if A = Simulation_Time_Unit_Array_Double and B = Simulation_Array_Double then Ok := True; end if; if A = Simulation_Time_Unit_Array_Integer and B = Simulation_Integer then Ok := True; end if; if A = Simulation_Time_Unit_Array_String and B = Simulation_String then Ok := True; end if; if A = Simulation_Time_Unit_Array_Boolean and B = Simulation_Boolean then Ok := True; end if; if A = Simulation_Time_Unit_Array_Double and B = Simulation_Double then Ok := True; end if; end Reversable_Check; begin Reversable_Check (a, b); Reversable_Check (b, a); return Ok; end has_compatible_type; end Simulations.Extended;