----------------------------------------------------------- --------------------- ------------------------------------------------------------------------------ -- 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: 548 $ -- $Date: 2012-10-12 01:48:51 +0200 (Fri, 12 Oct 2012) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Numerics.Aux; use Ada.Numerics.Aux; with indexed_tables; with natural_util; use natural_util; with double_util; use double_util; with Text_IO; use Text_IO; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Finalization; with primitive_xml_strings; use primitive_xml_strings; with Queueing_Systems; use Queueing_Systems; package Queueing_System is Not_Implemented : exception; function Qs_To_Display_String (A_Qs : in Queueing_Systems_Type) return Unbounded_String; procedure Display_String_To_Qs (From : in Unbounded_String; To : out Queueing_Systems_Type; Ok : out Boolean); Arrival_Rate_Table_Size : constant Natural := 100; Service_Rate_Table_Size : constant Natural := 100; Resp_Time_Table_Size : constant Natural := 1000; Resp_Time_Consumer_Table_Size : constant Natural := 1000; package A_Arrival_Rate is new indexed_tables ( Double, Natural, Arrival_Rate_Table_Size, 0, double_util.put, double_util.initialize, natural_util.put, format, XML_String, xml_ref_string); use A_Arrival_Rate; package A_Service_Rate is new indexed_tables ( Double, Natural, Service_Rate_Table_Size, 0, double_util.put, double_util.initialize, natural_util.put, format, XML_String, xml_ref_string); use A_Service_Rate; package A_Resp_Time is new indexed_tables ( Double, Natural, Resp_Time_Table_Size, 0, double_util.put, double_util.initialize, natural_util.put, format, XML_String, xml_ref_string); use A_Resp_Time; package A_Resp_Time_Consumer is new indexed_tables ( Double, Natural, Resp_Time_Consumer_Table_Size, 0, double_util.put, double_util.initialize, natural_util.put, format, XML_String, xml_ref_string); use A_Resp_Time_Consumer; subtype Arrival_Rate_Table is A_Arrival_Rate.indexed_table; subtype Arrival_Rate_Range is A_Arrival_Rate.indexed_table_range; subtype Service_Rate_Table is A_Service_Rate.indexed_table; subtype Service_Rate_Range is A_Service_Rate.indexed_table_range; subtype Resp_Time_Consumer_Table is A_Resp_Time_Consumer.indexed_table; subtype Resp_Time_Consumer_Table_Ptr is A_Resp_Time_Consumer.indexed_table_ptr; subtype Resp_Time_Consumer_Range is A_Resp_Time_Consumer.indexed_table_range; subtype Resp_Time_Table is A_Resp_Time.indexed_table; subtype Resp_Time_Table_Ptr is A_Resp_Time.indexed_table_ptr; subtype Resp_Time_Range is A_Resp_Time.indexed_table_range; type Generic_Queueing_System is abstract new Ada.Finalization.Controlled with record Queueing_System_Type : Queueing_Systems_Type; Arrival_Rate : Arrival_Rate_Table; Service_Rate : Service_Rate_Table; Nb_Of_Messages : Double; Var_Service : Double; -- variance service time for mg1 Avg_Service : Double; -- average service time for mg1 Waiting_Time : Double; Utilisation : Double; Max_State : Natural; Nb_Arrival : Double; -- nb of producer or arrival flow Nb_Server : Double; -- nb of server or consumer Harmonic : Boolean; -- for PP1 qs -- mp1 criteria computation -- Consumer_Resp_Time : Resp_Time_Consumer_Table_Ptr; Consumer_Resp_Time_Cpt : Resp_Time_Consumer_Range; end record; type Queueing_System_Ptr is access all Generic_Queueing_System'Class; procedure Initialize (A_Queueing_System : in out Generic_Queueing_System); -- Initialize a queueing system with a constant consumer response time -- procedure Set_Constant_Consumer_Response_Time (A_Queueing_System : in out Generic_Queueing_System'Class; Response_Time : in Double); -- reset queueing system values -- procedure Reset (A_Queueing_System : in out Generic_Queueing_System); -- display all queueing system caracteristics -- procedure Put (A_Queueing_System : in Generic_Queueing_System); -- get or set queueing system caracteristics -- procedure Set_Qs_Arrival_Rate (A_Queueing_System : in out Generic_Queueing_System'Class; Value : in Double); procedure Set_Qs_Arrival_Rate (A_Queueing_System : in out Generic_Queueing_System'Class; Place : in Arrival_Rate_Range; Value : in Double); function Get_Qs_Arrival_Rate (A_Queueing_System : in Generic_Queueing_System'Class; Place : in Arrival_Rate_Range) return Double; procedure Set_Qs_Service_Rate (A_Queueing_System : in out Generic_Queueing_System'Class; Value : in Double); procedure Set_Qs_Service_Rate (A_Queueing_System : in out Generic_Queueing_System'Class; Place : in Service_Rate_Range; Value : in Double); function Get_Qs_Service_Rate (A_Queueing_System : in Generic_Queueing_System'Class; Place : in Service_Rate_Range) return Double; procedure Set_Qs_Utilisation (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double); function Get_Qs_Utilisation (A_Queueing_System : in Generic_Queueing_System'Class) return Double; procedure Set_Qs_Type (A_Queueing_System : in out Generic_Queueing_System'Class; Qs_Type : in Queueing_Systems_Type); function Get_Qs_Type (A_Queueing_System : in Generic_Queueing_System'Class) return Queueing_Systems_Type; procedure Set_Qs_Nb_Of_Messages (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double); function Get_Qs_Nb_Of_Messages (A_Queueing_System : in Generic_Queueing_System'Class) return Double; procedure Set_Qs_Waiting_Time (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double); function Get_Qs_Waiting_Time (A_Queueing_System : in Generic_Queueing_System'Class) return Double; procedure Set_Qs_Max_State (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Natural); function Get_Qs_Max_State (A_Queueing_System : in Generic_Queueing_System'Class) return Natural; procedure Set_Qs_Nb_Arrival (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double); function Get_Qs_Nb_Arrival (A_Queueing_System : in Generic_Queueing_System'Class) return Double; procedure Set_Qs_Nb_Server (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Double); function Get_Qs_Nb_Server (A_Queueing_System : in Generic_Queueing_System'Class) return Double; procedure Set_Qs_Harmonic (A_Queueing_System : in out Generic_Queueing_System'Class; Value : Boolean); function Get_Qs_Harmonic (A_Queueing_System : in Generic_Queueing_System'Class) return Boolean; -- return the name of the queueing system -- function Get_Name (A_Queueing_System : in Generic_Queueing_System'Class) return Unbounded_String; -- set queueing system caracteristics -- needed, for instance, if you want theoretical results after a simulation -- procedure Set_Qs_Basic_Parameters (A_Queueing_System : in out Generic_Queueing_System'Class; A_Source_Queueing_System : in Generic_Queueing_System); end Queueing_System;