------------------------------------------------------------- ------------------- ------------------------------------------------------------------------------ -- 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 Qs_Tools; use Qs_Tools; package body Queueing_System.Simulation is procedure Simulate (A_Queueing_System : in out Generic_Queueing_System_Simulation'Class; Simulation_Time : in Double; Consumer_Nb_Instance : in Resp_Time_Consumer_Range) is package Double_Io is new Text_IO.Float_IO (Double); use Double_Io; function Min (X : in Double; Y : in Double) return Double is begin if X < Y then return X; else return Y; end if; end Min; Mtba : constant Double := 1.0 / A_Queueing_System.Arrival_Rate.entries (0).data; Mst : constant Double := 1.0 / A_Queueing_System.Service_Rate.entries (0).data; Rho : constant Double := Mst / Mtba; T_Prev : Double := 0.0; T_Arr : Double := 0.0; T_Dep : Double := 0.0; Nbcustomers : Double := 0.0; -- mean inter arrival time computation Nb_It : Double := 0.0; Tmp_It : Double := 0.0; Sim_Mit : Double := 0.0; -- mean service time computation Nb_St : Double := 0.0; Tmp_St : Double := 0.0; Tmp_Ptr : double_ptr; Sim_Mst : Double := 0.0; Sim_Var_Mst : Double := 0.0; -- mean queueing system waiting time computation Arrival_Date : Generic_Index_Lst.list; Sim_Mwt : Double := 0.0; Tmp_Wt : Double := 0.0; Nb_Wt : Double := 0.0; -- mean queueing system occupation computation Sim_Mnc : Double := 0.0; Seed : Generator; Seed_Rt : Generator; begin -- initialization Reset (Seed, 0); Reset (Seed_Rt, 0); -- response time (MP1) A_Queueing_System.Consumer_Resp_Time.nb_entries := Consumer_Nb_Instance; A_Queueing_System.Consumer_Resp_Time_Cpt := 0; for I in 0 .. A_Queueing_System.Consumer_Resp_Time.nb_entries - 1 loop A_Queueing_System.Consumer_Resp_Time.entries (I).data := --0.0; Get_Rand_Parameter (0.0, Mst, Seed_Rt); -- Put_Line("r" & I'Img & " " & Ri'Img); end loop; -- first arrival (obviously the first event) Tmp_It := Compute_Inter_Arrival_Time (A_Queueing_System, Seed); Nb_It := Nb_It + 1.0; T_Arr := Tmp_It; Sim_Mit := Sim_Mit + Tmp_It; T_Prev := Tmp_It; -- Nbcustomers := 1.0; -- waiting time computation Tmp_Ptr := new Double; Tmp_Ptr.all := T_Arr; add (Arrival_Date, Tmp_Ptr); -- first departure -- a remettre (MP1)?? A_Queueing_System.T_Arr := Tmp_Wt; Tmp_St := Compute_Service_Time (A_Queueing_System, Seed); Nb_St := Nb_St + 1.0; Sim_Mst := Sim_Mst + Tmp_St; Sim_Var_Mst := Sim_Var_Mst + Tmp_St * Tmp_St; -- next departure date T_Dep := T_Arr + Tmp_St; -- A_Queueing_System.Empty_Buffer := True; -- -- waiting time of 1 message in the system -- Tmp_Wt := Get_Tail(Arrival_Date).all; -- Delete(Arrival_Date,Get_Tail(Arrival_Date)); -- Tmp_Wt := T_Dep - Tmp_Wt; -- Sim_Mwt := Sim_Mwt + Tmp_Wt; -- Nb_Wt := Nb_Wt + 1.0; -- -- new arrival -- Tmp_It := Compute_Arrival(A_Queueing_System,Seed); -- A_Queueing_System.T_Arr := A_Queueing_System.T_Arr + Tmp_It; -- Sim_Mit := Sim_Mit + Tmp_It; -- Nb_It := Nb_It + 1.0; -- -- waiting time computation -- Tmp_Ptr := new Double; -- Tmp_Ptr.All := A_Queueing_System.T_Arr; -- Add (Arrival_Date, Tmp_Ptr); while (Min (T_Arr, T_Dep) < Simulation_Time) loop -- arrival if (T_Arr < T_Dep) then -- queueing system average occupation computation Sim_Mnc := Sim_Mnc + Nbcustomers * (T_Arr - T_Prev); Nbcustomers := Nbcustomers + 1.0; T_Prev := T_Arr; -- new arrival date Tmp_It := Compute_Inter_Arrival_Time (A_Queueing_System, Seed); T_Arr := T_Arr + Tmp_It; Sim_Mit := Sim_Mit + Tmp_It; Nb_It := Nb_It + 1.0; -- waiting time computation Tmp_Ptr := new Double; Tmp_Ptr.all := T_Arr; add (Arrival_Date, Tmp_Ptr); -- departure else -- queueing system average occupation computation Sim_Mnc := Sim_Mnc + Nbcustomers * (T_Dep - T_Prev); Nbcustomers := Nbcustomers - 1.0; T_Prev := T_Dep; Tmp_Wt := get_tail (Arrival_Date).all; if (Nbcustomers > 0.0) then A_Queueing_System.Empty_Buffer := False; T_Arr := T_Dep; Tmp_St := Compute_Service_Time (A_Queueing_System, Seed); T_Dep := T_Dep + Tmp_St; else A_Queueing_System.Empty_Buffer := True; T_Arr := Tmp_Wt; -- oldest arrivale --date not computed Tmp_St := Compute_Service_Time (A_Queueing_System, Seed); T_Dep := T_Arr + Tmp_St; end if; Nb_St := Nb_St + 1.0; Sim_Mst := Sim_Mst + Tmp_St; Sim_Var_Mst := Sim_Var_Mst + Tmp_St * Tmp_St; -- waiting time computation delete (Arrival_Date, get_tail (Arrival_Date)); Tmp_Wt := T_Dep - Tmp_Wt; Sim_Mwt := Sim_Mwt + Tmp_Wt; Nb_Wt := Nb_Wt + 1.0; end if; end loop; -- !! Simulation result !! -- utilisation A_Queueing_System.Utilisation := Rho; -- Mean inter arrival time Sim_Mit := Sim_Mit / Nb_It; A_Queueing_System.Sim_Mit := Sim_Mit; -- Mean service time Sim_Mst := Sim_Mst / Nb_St; A_Queueing_System.Sim_Mst := Sim_Mst; -- Mean variance service time Sim_Var_Mst := Sim_Var_Mst / Nb_St - Sim_Mst * Sim_Mst; A_Queueing_System.Sim_Var_Mst := Sim_Var_Mst; -- mean waiting time Sim_Mwt := Sim_Mwt / Nb_Wt; A_Queueing_System.Sim_Mwt := Sim_Mwt; -- mean number of customer Sim_Mnc := Sim_Mnc + Nbcustomers * (Simulation_Time - T_Prev); Sim_Mnc := Sim_Mnc / Simulation_Time; A_Queueing_System.Sim_Mnc := Sim_Mnc; -- -- !! theoric results !! -- -- mg1 -- New_Line; -- Put_Line("MG1"); -- -- waiting time -- Tmp := Sim_Mst + Lambda * ( Sim_Mst * Sim_Mst + Sim_Var_Mst) -- /(2.0*(1.0 - Lambda * Mst)); -- Mst)); -- -- Put_Line("Mean packet waiting time value : " & --Tmp'Img); -- Put_Line("AWMG1 " & Rho'Img & " " & Tmp'Img); -- -- average occupation -- Tmp := Tmp * Lambda; -- -- Put_Line("Mean packet number value : " & Tmp'Img); -- Put_Line("AOMG1 " & Rho'Img & " " & Tmp'Img); -- -- mp1 -- New_Line; -- Put_Line("MP1"); -- -- service time -- Mp1_Mst := Mst /(2.0 * (1.0 - Lambda * (Mst/2.0))); -- -- Put_Line("Mean service time value : " & Mp1_Mst'Img); -- Put_Line("ASTMP1 " & Rho'Img & " " & Mp1_Mst'Img); -- Rau := Lambda * Mp1_Mst; -- -- variance -- Nb_Rt := 0.0; -- Prev_Rt := --10.0; -- A_Queueing_System.Consumer_Resp_Time.Entries -- (A_Queueing_System.Consumer_Resp_Time.Nb_Entries - 1).Data; -- for I in 0 .. A_Queueing_System.Consumer_Resp_Time.Nb_Entries- -- 1 loop -- Next_Rt := --10.0; -- A_Queueing_System.Consumer_Resp_Time.Entries(I).Data; -- Wi := Next_Rt + Mst - Prev_Rt; -- --Wi := (1.0 - Rau)* (Wi*Wi) / 4.0 + Rau * Wi * Wi; -- -- compute the variance -- Mp1_Var := Mp1_Var + Wi * Wi; -- Mp1_Var_Ro := Mp1_Var_Ro + (Wi * Wi / 4.0); -- Prev_Rt := Next_Rt; -- Nb_Rt := Nb_Rt + 1.0; -- end loop; -- -- nouveaux tests -- Mp1_Var := Mp1_Var / Nb_Rt; -- Mp1_Var_Ro := Mp1_Var_Ro / Nb_Rt; -- Put_Line("Mp1_Var " & Rho'Img & " " & Mp1_Var'Img); -- Put_Line("Mp1_mst " & Rho'Img & " " & Mp1_Mst'Img); -- --1 -- -- Mp1_Var := (1.0 + Lambda * Mst) * Mp1_Var - Mst * Mst; -- --2 -- --Mp1_Var := ((1.0 + 3.0 * Lambda * Mp1_Mst) / (4.0)) * Mp1_Var - -- --Mst * Mst; -- --3 -- --Mp1_Var := Mp1_Var - Mst * Mst; -- --4 -- -- Mp1_Var := 0.0; -- --5 -- --Mp1_Var := (1.0 - Rau) * Mst * Mst / 12.0 + Rau * (Mp1_Var - --Mst * -- -- Mst); -- --6 rho tends vers 0 -- --Mp1_Var :=Mst * Mst / 12.0 ; -- --7 rho tends vers 1 -- --Mp1_Var := Mp1_Var - Mst * Mst; -- -- 8 quelque soit rho -- Mp1_Var := (1.0 - Rau) * (Mst * Mst / 12.0) + Rau* (Mp1_Var - --Mst * -- Mst); -- --9 -- --Mp1_Var := (1.0 - rau) * (Mp1_Var_ro - (Mst * Mst / 2.0)) + --rau* (Mp1_Var - Mst * Mst); -- -- fin nouveaux tests -- -- Mp1_Var := Mp1_Var / Nb_Rt - Mp1_Mst * Mp1_Mst; -- -- Mp1_Var := -- -- (1.0 - Rau) * Mst * Mst / 12.0 + Rau * Mp1_Var; -- -- Mp1_Var := -- -- ((1.0 + 3.0 * Lambda * Mp1_Mst) / (4.0 * Nb_Rt)) * --Mp1_Var - -- -- Mp1_Mst * Mp1_Mst; -- -- Put_Line("Mean variance service time value : --" & Mp1_Var'Img); -- Put_Line("ASTVARMP1 " & Rho'Img & " " & Mp1_Var'Img); -- -- waiting time -- -- Tmp := Sim_Mst + Lambda * ( Sim_Mst * Sim_Mst + --Sim_Var_Mst) -- -- /(2.0*(1.0 - Lambda * Sim_Mst)); -- --Mp1_Var := Sim_Var_Mst; -- Tmp := Mp1_Mst + Lambda * ( Mp1_Mst * Mp1_Mst + Mp1_Var) -- /(2.0*(1.0 - Lambda * Mst)); -- Mst)); -- -- Put_Line("Mean packet waiting time value : " & --Tmp'Img); -- Put_Line("AWMP1 " & Rho'Img & " " & Tmp'Img); -- -- average occupation -- Tmp := Tmp * Lambda; -- -- Put_Line("Mean packet number value : " & Tmp'Img); -- Put_Line("AOMP1 " & Rho'Img & " " & Tmp'Img); -- --Tmp := Mst* Mst / 12.0; -- --Put_Line("var " & Tmp'Img); -- -- mm1 -- New_Line; -- Put_Line("MM1"); -- -- waiting time -- -- Tmp := 1.0/ (Mu * (1.0 - Lambda /Mu)); -- Tmp := 1.0/ (1.0/Sim_Mst * (1.0 - Lambda * Sim_Mst)); -- --Put_Line("Mean packet waiting time value : " & Tmp'Img); -- Put_Line("AWMM1SIM " & Rho'Img & " " & Tmp'Img); -- Tmp := 1.0/ (1.0/Mst * (1.0 - Lambda * Mst)); -- Put_Line("AWMM1PCONS " & Rho'Img & " " & Tmp'Img); -- Tmp := 1.0/ (1.0/ Mp1_Mst * (1.0 - Lambda * Mp1_Mst)); -- Put_Line("AWMM1THEO " & Rho'Img & " " & Tmp'Img); -- -- average occupation -- --Tmp := Mst/(Mtba-Mst); -- system -- -- Put_Line("Mean packet number value : " & Tmp'Img); -- Tmp := Sim_Mst / (Mtba-Sim_Mst); -- Put_Line("AOMM1SIM " & Rho'Img & " " & Tmp'Img); -- Tmp := Mst / (Mtba-Mst); -- Put_Line("AOMM1PCONS " & Rho'Img & " " & Tmp'Img); -- Tmp := Mp1_Mst / (Mtba-Mp1_Mst); -- Put_Line("AOMM1THEO " & Rho'Img & " " & Tmp'Img); -- -- Tmp := (Lambda * Mst ) / (1.0 - Rau); -- -- Put_Line("Mean packet number value : " & Tmp'Img); -- -- Mm1_Var := Mst*Mst; -- -- Put("service time Variance : " ); -- -- Put(Mm1_Var,Aft=>4, Exp => 0); -- -- New_Line; -- -- md1 -- New_Line; -- Put_Line("MD1"); -- -- waiting time -- -- Tmp := (2.0 - Rau) / (2.0* Mu *(1.0-Rau)); -- -- Put_Line("Mean packet waiting time value : " & --Tmp'Img); -- Tmp := -- (2.0 - Lambda*Sim_Mst) / ((2.0/Sim_Mst) --*(1.0-Lambda*Sim_Mst)); -- Put_Line("AWMD1SIM " & Rho'Img & " " & Tmp'Img); -- Tmp := -- (2.0 - Lambda*Mst) / ((2.0/Mst) *(1.0-Lambda*Mst)); -- Put_Line("AWMD1PCONS " & Rho'Img & " " & Tmp'Img); -- Tmp := -- (2.0 - Lambda*Mp1_Mst) / ((2.0/Mp1_Mst) --*(1.0-Lambda*Mp1_Mst)); -- Put_Line("AWMD1THEO " & Rho'Img & " " & Tmp'Img); -- -- average occupation -- -- Tmp := (2.0*Rau - Rau*Rau)/(2.0*(1.0-Rau)); -- -- Put_Line("Mean packet number value : " & Tmp'Img); -- Tmp := -- (2.0*Lambda*Sim_Mst - Lambda*Sim_Mst*Lambda*Sim_Mst)/(2.0*( -- 1.0-Lambda*Sim_Mst)); -- Put_Line("AOMD1SIM " & Rho'Img & " " & Tmp'Img); -- Tmp := -- (2.0*Lambda*Mst - Lambda*Mst*Lambda*Mst)/(2.0*( -- 1.0-Lambda*Mst)); -- Put_Line("AOMD1PCONS " & Rho'Img & " " & Tmp'Img); -- Tmp := -- (2.0*Lambda*Mp1_Mst - Lambda*Mp1_Mst*Lambda*Mp1_Mst)/(2.0*( -- 1.0-Lambda*Mp1_Mst)); -- Put_Line("AOMD1THEO " & Rho'Img & " " & Tmp'Img); end Simulate; procedure Simulation_Results (A_Queueing_System : in Generic_Queueing_System_Simulation'Class) is begin Put_Line ("Simulation Result"); New_Line; Put_Line ("AIT " & A_Queueing_System.Utilisation'Img & " " & A_Queueing_System.Sim_Mit'Img); Put_Line ("AST " & A_Queueing_System.Utilisation'Img & " " & A_Queueing_System.Sim_Mst'Img); Put_Line ("ASTVAR " & A_Queueing_System.Utilisation'Img & " " & A_Queueing_System.Sim_Var_Mst'Img); Put_Line ("AW " & A_Queueing_System.Utilisation'Img & " " & A_Queueing_System.Sim_Mwt'Img); Put_Line ("AO " & A_Queueing_System.Utilisation'Img & " " & A_Queueing_System.Sim_Mnc'Img); New_Line; end Simulation_Results; procedure Initialize (A_Queueing_System : in out Generic_Queueing_System_Simulation) is begin Initialize (Generic_Queueing_System (A_Queueing_System)); if A_Queueing_System.Service_Resp_Time /= null then free (A_Queueing_System.Service_Resp_Time); end if; A_Queueing_System.Service_Resp_Time := new Resp_Time_Table; A_Queueing_System.Service_Resp_Time.nb_entries := 0; A_Queueing_System.Avg_Service := 0.0; A_Queueing_System.Var_Service := 0.0; end Initialize; procedure Reset (A_Queueing_System : in out Generic_Queueing_System_Simulation) is begin Initialize (Generic_Queueing_System_Simulation (A_Queueing_System)); end Reset; procedure Generate_Arrival_And_Service_Rate (A_Queueing_System : in out Generic_Queueing_System_Simulation'Class; Utilization : in Double; Seed : in Generator; Max_Mu : in Natural := 4000) is Tmp_Inter_Time : Double; begin -- initialisation A_Queueing_System.Arrival_Rate.nb_entries := 1; A_Queueing_System.Service_Rate.nb_entries := 1; -- arrival rate random generation Tmp_Inter_Time := Get_Rand_Parameter (100.0, -- 1000 Double (Max_Mu), Seed); A_Queueing_System.Arrival_Rate.entries (0).data := 1.0 / Tmp_Inter_Time; -- compute the departure rate A_Queueing_System.Service_Rate.entries (0).data := A_Queueing_System.Arrival_Rate.entries (0).data / Utilization; -- queueing system utilization A_Queueing_System.Utilisation := A_Queueing_System.Arrival_Rate.entries (0).data / A_Queueing_System.Service_Rate.entries (0).data; end Generate_Arrival_And_Service_Rate; end Queueing_System.Simulation;