------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 natural_util; use natural_util; package body Queueing_System is procedure Set_Constant_Consumer_Response_Time (A_Queueing_System : in out Generic_Queueing_System'Class; Response_Time : in Double) is begin A_Queueing_System.Consumer_Resp_Time.entries (0).data := Response_Time; A_Queueing_System.Consumer_Resp_Time.nb_entries := 1; end Set_Constant_Consumer_Response_Time; function Qs_To_Display_String (A_Qs : in Queueing_Systems_Type) return Unbounded_String is S : Unbounded_String; begin case A_Qs is when Qs_Pp1 => S := To_Unbounded_String ("P/P/1"); when Qs_Mm1 => S := To_Unbounded_String ("M/M/1"); when Qs_Md1 => S := To_Unbounded_String ("M/D/1"); when Qs_Mp1 => S := To_Unbounded_String ("M/P/1"); when Qs_Mg1 => S := To_Unbounded_String ("M/G/1"); when Qs_Mms => S := To_Unbounded_String ("M/M/s"); when Qs_Mds => S := To_Unbounded_String ("M/D/s"); when Qs_Mps => S := To_Unbounded_String ("M/P/s"); when Qs_Mgs => S := To_Unbounded_String ("M/G/s"); when Qs_Mm1n => S := To_Unbounded_String ("M/M/1/n"); when Qs_Md1n => S := To_Unbounded_String ("M/D/1/n"); when Qs_Mp1n => S := To_Unbounded_String ("M/P/1/n"); when Qs_Mg1n => S := To_Unbounded_String ("M/G/1/n"); when Qs_Mmsn => S := To_Unbounded_String ("M/M/s/n"); when Qs_Mdsn => S := To_Unbounded_String ("M/D/s/n"); when Qs_Mpsn => S := To_Unbounded_String ("M/P/s/n"); when Qs_Mgsn => S := To_Unbounded_String ("M/G/s/n"); end case; return S; end Qs_To_Display_String; procedure Display_String_To_Qs (From : in Unbounded_String; To : out Queueing_Systems_Type; Ok : out Boolean) is begin Ok := False; if From = To_Unbounded_String ("P/P/1") then To := Qs_Pp1; Ok := True; end if; if From = To_Unbounded_String ("M/M/1") then To := Qs_Mm1; Ok := True; end if; if From = To_Unbounded_String ("M/D/1") then To := Qs_Md1; Ok := True; end if; if From = To_Unbounded_String ("M/P/1") then To := Qs_Mp1; Ok := True; end if; if From = To_Unbounded_String ("M/G/1") then To := Qs_Mg1; Ok := True; end if; if From = To_Unbounded_String ("M/M/s") then To := Qs_Mms; Ok := True; end if; if From = To_Unbounded_String ("M/D/s") then To := Qs_Mds; Ok := True; end if; if From = To_Unbounded_String ("M/P/s") then To := Qs_Mps; Ok := True; end if; if From = To_Unbounded_String ("M/G/s") then To := Qs_Mgs; Ok := True; end if; if From = To_Unbounded_String ("M/M/1/n") then To := Qs_Mm1n; Ok := True; end if; if From = To_Unbounded_String ("M/D/1/n") then To := Qs_Md1n; Ok := True; end if; if From = To_Unbounded_String ("M/P/1/n") then To := Qs_Mp1n; Ok := True; end if; if From = To_Unbounded_String ("M/G/1/n") then To := Qs_Mg1n; Ok := True; end if; if From = To_Unbounded_String ("M/M/s/n") then To := Qs_Mmsn; Ok := True; end if; if From = To_Unbounded_String ("M/D/s/n") then To := Qs_Mdsn; Ok := True; end if; if From = To_Unbounded_String ("M/P/s/n") then To := Qs_Mpsn; Ok := True; end if; if From = To_Unbounded_String ("M/G/s/n") then Ok := True; To := Qs_Mgsn; end if; end Display_String_To_Qs; procedure Set_Qs_Type (A_Queueing_System : in out Generic_Queueing_System'Class; Qs_Type : in Queueing_Systems_Type) is begin A_Queueing_System.Queueing_System_Type := Qs_Type; end Set_Qs_Type; function Get_Qs_Type (A_Queueing_System : in Generic_Queueing_System'Class) return Queueing_Systems_Type is begin return A_Queueing_System.Queueing_System_Type; end Get_Qs_Type; procedure Set_Qs_Arrival_Rate (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double) is begin A_Queueing_System.Arrival_Rate.entries ( A_Queueing_System.Arrival_Rate.nb_entries).data := Value; A_Queueing_System.Arrival_Rate.nb_entries := A_Queueing_System.Arrival_Rate.nb_entries + 1; end Set_Qs_Arrival_Rate; procedure Set_Qs_Arrival_Rate (A_Queueing_System : in out Generic_Queueing_System'Class; Place : Arrival_Rate_Range; Value : Double) is begin A_Queueing_System.Arrival_Rate.entries (Place).data := Value; end Set_Qs_Arrival_Rate; function Get_Qs_Arrival_Rate (A_Queueing_System : in Generic_Queueing_System'Class; Place : Arrival_Rate_Range) return Double is begin return A_Queueing_System.Arrival_Rate.entries (Place).data; end Get_Qs_Arrival_Rate; procedure Set_Qs_Service_Rate (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double) is begin A_Queueing_System.Service_Rate.entries ( A_Queueing_System.Service_Rate.nb_entries).data := Value; A_Queueing_System.Service_Rate.nb_entries := A_Queueing_System.Service_Rate.nb_entries + 1; end Set_Qs_Service_Rate; procedure Set_Qs_Service_Rate (A_Queueing_System : in out Generic_Queueing_System'Class; Place : Service_Rate_Range; Value : Double) is begin A_Queueing_System.Service_Rate.entries (Place).data := Value; end Set_Qs_Service_Rate; function Get_Qs_Service_Rate (A_Queueing_System : in Generic_Queueing_System'Class; Place : Service_Rate_Range) return Double is begin return A_Queueing_System.Service_Rate.entries (Place).data; end Get_Qs_Service_Rate; procedure Set_Qs_Utilisation (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double) is begin A_Queueing_System.Utilisation := Value; end Set_Qs_Utilisation; function Get_Qs_Utilisation (A_Queueing_System : in Generic_Queueing_System'Class) return Double is begin return A_Queueing_System.Utilisation; end Get_Qs_Utilisation; procedure Set_Qs_Nb_Of_Messages (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double) is begin A_Queueing_System.Nb_Of_Messages := Value; end Set_Qs_Nb_Of_Messages; function Get_Qs_Nb_Of_Messages (A_Queueing_System : in Generic_Queueing_System'Class) return Double is begin return A_Queueing_System.Nb_Of_Messages; end Get_Qs_Nb_Of_Messages; procedure Set_Qs_Waiting_Time (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double) is begin A_Queueing_System.Waiting_Time := Value; end Set_Qs_Waiting_Time; function Get_Qs_Waiting_Time (A_Queueing_System : in Generic_Queueing_System'Class) return Double is begin return A_Queueing_System.Waiting_Time; end Get_Qs_Waiting_Time; procedure Set_Qs_Max_State (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Natural) is begin A_Queueing_System.Max_State := Value; end Set_Qs_Max_State; function Get_Qs_Max_State (A_Queueing_System : in Generic_Queueing_System'Class) return Natural is begin return A_Queueing_System.Max_State; end Get_Qs_Max_State; procedure Set_Qs_Nb_Arrival (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double) is begin A_Queueing_System.Nb_Arrival := Value; end Set_Qs_Nb_Arrival; function Get_Qs_Nb_Arrival (A_Queueing_System : in Generic_Queueing_System'Class) return Double is begin return A_Queueing_System.Nb_Arrival; end Get_Qs_Nb_Arrival; procedure Set_Qs_Nb_Server (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double) is begin A_Queueing_System.Nb_Server := Value; end Set_Qs_Nb_Server; function Get_Qs_Nb_Server (A_Queueing_System : in Generic_Queueing_System'Class) return Double is begin return A_Queueing_System.Nb_Server; end Get_Qs_Nb_Server; procedure Set_Qs_Harmonic (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Boolean) is begin A_Queueing_System.Harmonic := Value; end Set_Qs_Harmonic; function Get_Qs_Harmonic (A_Queueing_System : in Generic_Queueing_System'Class) return Boolean is begin return A_Queueing_System.Harmonic; end Get_Qs_Harmonic; procedure Initialize (A_Queueing_System : in out Generic_Queueing_System) is begin initialize (A_Queueing_System.Arrival_Rate); initialize (A_Queueing_System.Service_Rate); A_Queueing_System.Nb_Of_Messages := 0.0; A_Queueing_System.Waiting_Time := 0.0; A_Queueing_System.Utilisation := 0.0; A_Queueing_System.Max_State := 0; A_Queueing_System.Var_Service := 0.0; A_Queueing_System.Avg_Service := 0.0; A_Queueing_System.Nb_Arrival := 0.0; A_Queueing_System.Nb_Server := 0.0; A_Queueing_System.Harmonic := False; A_Queueing_System.Consumer_Resp_Time := new Resp_Time_Consumer_Table; A_Queueing_System.Consumer_Resp_Time_Cpt := 0; end Initialize; procedure Reset (A_Queueing_System : in out Generic_Queueing_System) is begin Initialize (A_Queueing_System); end Reset; procedure Put (A_Queueing_System : in Generic_Queueing_System) is Arrival_Period : constant Double := 1.0 / A_Queueing_System.Arrival_Rate.entries (0).data; Service_Period : constant Double := 1.0 / A_Queueing_System.Service_Rate.entries (0).data; Rho : constant Double := A_Queueing_System.Utilisation; package Double_Io is new Text_IO.Float_IO (Double); use Double_Io; begin Put_Line ("# Name " & To_String (Get_Name (A_Queueing_System))); Put ("# Arrival rate (lambda) = 1/"); Put (Arrival_Period, Aft => 4, Exp => 0); New_Line; Put ("# Service rate (mu) = 1/"); Put (Service_Period, Aft => 4, Exp => 0); New_Line; Put ("# Utilisation (rho) = "); Put (Rho, Aft => 4, Exp => 0); New_Line; New_Line; end Put; function Get_Name (A_Queueing_System : in Generic_Queueing_System'Class) return Unbounded_String is Result : Unbounded_String; begin if A_Queueing_System.Queueing_System_Type = Qs_Pp1 then Result := To_Unbounded_String ("PP1"); else if A_Queueing_System.Queueing_System_Type = Qs_Mm1 then Result := To_Unbounded_String ("MM1"); else if A_Queueing_System.Queueing_System_Type = Qs_Md1 then Result := To_Unbounded_String ("MD1"); else if A_Queueing_System.Queueing_System_Type = Qs_Mp1 then Result := To_Unbounded_String ("MP1"); else if A_Queueing_System.Queueing_System_Type = Qs_Mg1 then Result := To_Unbounded_String ("MG1"); else if A_Queueing_System.Queueing_System_Type = Qs_Mms then Result := To_Unbounded_String ("MMS"); else if A_Queueing_System.Queueing_System_Type = Qs_Mds then Result := To_Unbounded_String ("MDS"); else if A_Queueing_System.Queueing_System_Type = Qs_Mps then Result := To_Unbounded_String ("MPS"); else if A_Queueing_System.Queueing_System_Type = Qs_Mgs then Result := To_Unbounded_String ("MGS"); else if A_Queueing_System.Queueing_System_Type = Qs_Mm1n then Result := To_Unbounded_String ("MM1N"); else if A_Queueing_System.Queueing_System_Type = Qs_Md1n then Result := To_Unbounded_String ("MD1N"); else if A_Queueing_System. Queueing_System_Type = Qs_Mp1n then Result := To_Unbounded_String ("MP1N"); else if A_Queueing_System. Queueing_System_Type = Qs_Mg1n then Result := To_Unbounded_String ("MG1N"); else if A_Queueing_System. Queueing_System_Type = Qs_Mmsn then Result := To_Unbounded_String ("MMSN"); else if A_Queueing_System. Queueing_System_Type = Qs_Mdsn then Result := To_Unbounded_String ("MDSN"); else if A_Queueing_System. Queueing_System_Type = Qs_Mpsn then Result := To_Unbounded_String ("MPSN"); else if A_Queueing_System. Queueing_System_Type = Qs_Mgsn then Result := To_Unbounded_String ("MGSN"); else Result := To_Unbounded_String ("?"); end if; end if; end if; end if; end if; end if; end if; end if; end if; end if; end if; end if; end if; end if; end if; end if; end if; return Result; end Get_Name; procedure Set_Qs_Basic_Parameters (A_Queueing_System : in out Generic_Queueing_System'Class; A_Source_Queueing_System : in Generic_Queueing_System) is begin Set_Qs_Arrival_Rate (A_Queueing_System, 0, Get_Qs_Arrival_Rate (A_Source_Queueing_System, 0)); Set_Qs_Service_Rate (A_Queueing_System, 0, Get_Qs_Service_Rate (A_Source_Queueing_System, 0)); Set_Qs_Utilisation (A_Queueing_System, Get_Qs_Utilisation (A_Source_Queueing_System)); Set_Qs_Nb_Arrival (A_Queueing_System, Get_Qs_Nb_Arrival (A_Source_Queueing_System)); Set_Qs_Nb_Server (A_Queueing_System, Get_Qs_Nb_Server (A_Source_Queueing_System)); Set_Qs_Max_State (A_Queueing_System, Get_Qs_Max_State (A_Source_Queueing_System)); Set_Qs_Nb_Of_Messages (A_Queueing_System, Get_Qs_Nb_Of_Messages (A_Source_Queueing_System)); end Set_Qs_Basic_Parameters; end Queueing_System;