UNIT QNETobj;

{Modified from standard Pascal toolbox in
          Wolfgang Kreutzer,
          System Simulation, programming styles and Languages, 1986,
          ISBN 0-201-12914-0, p 245 ff.}
{the OOP version for turbo Pascal 6.0}
{real objects: Lin Jensen
               Sept - Oct. 1996
               Nov. 12, 1996   -- Server Unavailable with statistics}
{
 Proposal:
 A resource can be made "unavailable" by another process, which should
 be reflected in the usage report. This raises questions:
     What about processes which are currently using?
     What about waiting processes?
 GPSS allows several options, from orderly leaving to abruptly
    sending other transactions off.

AVAilability is implemented for servers in QNETOBJ. There the only
option is to allow services to finish, but allow no new starts after
a MakeUnavailable request. The status of the server actually changes
from "busy" to "unavailable" when the last service finishes.

}
INTERFACE
USES CLOCK, QUEUE, SIMOBJ;

{ UTILITIES FOR SIMULATING QUEUEING NETWORK SCENARIOS }
{* * * * * * * * * * * * * * * * * * * * * * * * * * * }

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
{ * These utilities should be used together with the                 * }
{ * DES or COMBINED simulation utility packages                      * }
{ * * * * * * * * * * * * * * * * * * * * * * * * * *  * * * * * * * * }

{Data Type Declarations}
{  = = = = = = = = = = = }

TYPE

{ * * * * * TRANSACTIONs used to represent workload items}

aTAPtrType = ^ aTArecordType ;

aTArecordType = OBJECT (QueueElement)
   constructor Init (time : real);
   function BirthTimeQ : real;      {once constructed, it is read-Only!}
private
   birthTime  : REAL;
   {these TAs can only be in at most one queue at a time ! }
end;

{ * * * * * SOURCEs & SINKs used to record generation}
{       and destructions of workload items           }

aSourceType =  OBJECT (aSimObject)
   constructor Init;
   procedure Reset;      virtual;
   function  CreateNewTA : aTAPtrType;
   procedure Report ;    virtual;
private
        creationCount : 0.. MAXINT;
end;

aSinkType = OBJECT (aSimObject)
   constructor Init;
   procedure RemoveTA ( ta : aTAPtrType);
   procedure Reset  ;      virtual;
   procedure Report ;      virtual;
private
           destructionCount: 0.. MAXINT;
end;

{ * * * * * Resources used to represent SERVER units}

ServerStates = (idle, busy, unavailable);

aServerType = OBJECT  (aSimObject)
   constructor Init ( capacityP : INTEGER);
   constructor SubInit ( capacityP : INTEGER);
   procedure Reset;       virtual;
   procedure SeizeServer  ( howMuch : INTEGER);
   procedure ReleaseServer (howMuch : INTEGER);
   procedure MakeUnAvailable;
   procedure MakeAvailable;
   function  NotAvailable : boolean;    {is it currently unavailable to seize?}
   function  EnoughServerUnitsAvailableP (units : INTEGER  ): BOOLEAN;
   procedure Report ;      virtual;
   function  ServerUtilizationQ : REAL;
   function  ServerUtilizationAvailQ : REAL;
   function  CapacityQ : integer;
   function  StateQ    : ServerStates;
private
               capacity          : 0.. MAXINT;
               inUse             : 0.. MAXINT;
               state             : ServerStates ;
               timeOfLastChange  : REAL;
               useIntegral       : REAL;
               NotAvailReq       : Boolean;
                                 {make unavail. when no longer busy}
               DownTime          : REAL;    {time unavailable}
   function DowntimePctQ         : REAL;
           end;

{ * * * * * QUEUEs to represent waiting lines of transactions}



aQueueType = OBJECT (aSimObject)
                 Q                 : fifoQueue;
   constructor Init;
   procedure   Reset;   virtual;
   procedure   Report;  virtual;
   destructor  Destroy; virtual;
   procedure FileIntoFIFOq ( ta : aTAPtrType);
   function  TakeFirstFromQ  : aTAPtrType;
   function  length : INTEGER;         {Read-only determine length}
   function  MeanQlengthQ  : REAL;
   function  MaxQlengthQ : INTEGER;
   function  MeanQdelayQ  : REAL;
private
                 timeOfLastChange  : REAL;
                 maxlength         : 0.. MAXINT;
                 lengthIntegral    : REAL;
                 noOfEntries       : 0.. MAXINT;
                 noOfDepartures    : 0.. MAXINT;
end;



{ * * * * * Messages to TRANSACTIONs}

function FlowTimeQ (ta: aTAPtrType) : REAL;

IMPLEMENTATION

{Utility Functions and Procedures for Building Queueing Scenarios}
{  = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =  }

constructor aTArecordType.Init (time : REAL);
begin
   queueElement.Init;
   birthtime := time;
end;


{ * * * * * Messages to SOURCEs}
constructor aSourceType.init;
begin
   aSimObject.Init ( 'TA generations');
  creationCount  := 0;
end;

procedure aSourceType.Reset;
begin
  aSimObject.Reset;
  creationCount  := 0;
end;

function aSourceType.CreateNewTA  : aTAPtrType;
  var
  thisOne : aTAPtrType;
begin
  creationCount := creationCount +  1;
  if traceFlag then
    WRITELN ('New TA created at ',TheClock.NOW:7:2);
  NEW(thisOne, init(TheClock.NOW));
  CreateNewTA        := thisOne;
end;

procedure aSourceType.Report;
begin
  aSimObject.report;
  WRITE    (creationCount:5,' transactions ');
  WRITELN ('were created.');
end;

{ * * * * * Messages to SINks}

constructor aSinkType.Init;
begin
  aSimObject.Init ( 'TA departures');
  destructionCount := 0;
end;

procedure aSinkType.Reset;
begin
  aSimObject.Reset;
  destructionCount := 0;
end;

procedure aSinkType.RemoveTA ( ta : aTAPtrType);
begin
  if traceFlag then
   WRITELN('TA departs at ',TheClock.NOW:8:2);
  DISPOSE(ta, destroy);
  destructionCount := destructionCount +  1;
end;

procedure aSinkType.Report ;
begin
  aSimObject.Report;
  WRITE    (destructionCount :5);
  WRITELN (' transactions were removed through this sink.');
end;

{ * * * * * Messages to TRANSACTIONs}

function FlowTimeQ (ta: aTAPtrType) : REAL;
begin
  FlowTimeQ := TheClock. NOW - ta ^. birthTime;
end;

function aTArecordType.BirthTimeQ : real;
begin
   BirthtimeQ := BirthTime;
end;

{ * * * * * Messages to SERVERs}

constructor aServerType.Init ( capacityP : INTEGER);
begin
  if capacityP <= 0 then
   WRITELN ('Capacity must be > 0!')
  else
     begin
        aSimObject.Init ('server');
        capacity            := capacityP;
        inUse               := 0;
        state               := idle;
        timeOfLastChange    := 0.0;
        useIntegral         := 0.0;
        DownTime            := 0.0;
        NotAvailReq         := FALSE;

     end;
end; {of InitServer procedure }

constructor aServerType.SubInit ( capacityP : INTEGER);
begin
  if capacityP <= 0 then
   WRITELN ('Capacity must be > 0!')
  else
     begin
        aSimObject.SubInit ('server');
        capacity            := capacityP;
        inUse               := 0;
        state               := idle;
        timeOfLastChange    := 0.0;
        useIntegral         := 0.0;
        DownTime            := 0.0;
        NotAvailReq         := FALSE;

     end;
end; {of InitServer procedure }

procedure aServerType.Reset;
begin
  aSimObject.reset;
  useIntegral := 0.0;
  DownTime    := 0.0;
end;

procedure aServerType.SeizeServer ( howMuch : INTEGER);
begin
  if ((howMuch < 0) and ( capacity < (  inUse + howMuch))) then
   begin
      WRITELN ('The number of server units requested must be > 0');
      WRITELN ('and < = the available capacity!');
   end
  else if NotAvailReq then
     writeln (Description, ' is currently unavailable')
  else
      begin
        if traceFlag then
          WRITELN ('A service starts at',TheClock.NOW:8:2);
        useIntegral := useIntegral + (inUse * (TheClock.NOW -
                     timeOfLastChange));
        inUse      := inUse + howMuch;
         state        := busy;
       timeOfLastChange:= TheClock.NOW;
      end; {else}
end; {of SeizeServer procedure}


procedure aServerType.ReleaseServer (howMuch : INTEGER);
begin
  if howMuch > inUse then
    WRITELN ('Can''t release more than you have!')
  else
      begin
        if traceFlag then
          WRITELN ('A service by ',Description,' finishes at', TheClock.NOW:8:2);
        useIntegral := useIntegral + (inUse * (TheClock.NOW -
                     timeOfLastChange));
        inUse      := inUse - howMuch;
        if inUse <= 0 then             {All finished, can make unavailable}
          if NotAvailReq then
           begin
            state := Unavailable;
{            StartUnAvailTime := TheClock.Now;  can use timeoflastChange}
            if traceflag then
               writeln ('       ',Description, ' is now unoccupied and UNAVAILABLE');
           end
          else
            state := idle;
       timeOfLastChange:= TheClock.NOW;
      end; {with}
end; {of ReleaseServer procedure}

procedure aServerType.MakeUnavailable;
begin
   if TraceFlag then
      WRITELN ('UNAVAILABLE REQUESTED for ', description,
              ' at ',TheClock.NOW:8:2);
   NotAvailReq := TRUE;
   if state = idle then      {may have to defer unavail. until users leave}
      state := unavailable;
end;

procedure aServerType.MakeAvailable;
begin
   if TraceFlag then
      WRITELN ( description,
              ' BECOMES AVAILABLE at ',TheClock.NOW:8:2);
   NotAvailReq := FALSE;
   state := idle;
   DownTime := DownTime + (TheClock.NOW - TimeOfLastChange);
   {NOTE: The question of how potentially waiting customers shall be
          informed cannot be addressed in this unit}
end;

function aServerType.NotAvailable : boolean;
begin
   NotAvailable := NotAvailReq;  {could not seize because of request}
end;

function aServerType.EnoughServerUnitsAvailableP (
                               units  : INTEGER  ): BOOLEAN;
begin
  EnoughServerUnitsAvailableP := ((  inUse + units) <=   capacity)
                                 AND NOT NotAvailReq;
end;

function aServerType.ServerUtilizationQ : REAL;
begin
 if TheClock.NOW > StartTime then
    ServerUtilizationQ:=  useIntegral / (TheClock.NOW -  startTime)
  else
    ServerUtilizationQ := 0;
end;

function aServerType.ServerUtilizationAvailQ : REAL;
begin
 if (TheClock.NOW - Downtime) > StartTime then
    ServerUtilizationAvailQ:=  useIntegral / (TheClock.NOW - DownTime -  startTime)
  else
    ServerUtilizationAvailQ := 0;
end;

function aServerType.DownTimePctQ : real;
begin
  if TheClock.NOW > StartTime then
     downtimePctQ := Downtime / (TheClock.NOW - startTime)
  else
     downtimePctQ := 0.0;
end;

function aServerType.CapacityQ : integer;
begin
   CapacityQ := Capacity;
end;

function aServerType.StateQ : ServerStates;
begin
   StateQ := State;
end;

procedure aServerType.Report;
const
   Sstate : array [serverstates] of string[11] = ('idle','busy','unavailable');
begin
  aSimObject.Report;
  {----- update integrals to present ---}
        useIntegral := useIntegral + (inUse * (TheClock.NOW -
                     timeOfLastChange));
        if state =unavailable then
           downtime := downtime + (TheClock.NOW - timeOfLastChange);
  writeln ('It is currently ',SState[state]);
  WRITE    ('Utilization was ');
  WRITELN ((ServerUtilizationQ  * 100):5:2, '%');
  if downtime > 0 then
    begin
     writeln ('Down Time of ',Downtime:8:4, DowntimePctQ*100:6:2,'%');
     writeln ('Utilization while available was ',
             ServerUtilizationAvailQ*100:5:2,'%');
    end;
  WRITE   ('The capacity of this server is ',   capacity: 3  );
  WRITELN (' units.');
  WRITELN ( inUse:3, ' of these are currently in use .');
end;


{ * * * * * Messages to (Fifo) QUEUEs}

constructor aQueueType.Init ;
begin
      Q.Init;
      aSimObject.init ('queue movements');
      maxLength        :=   0;
      timeOfLastChange := 0.0;
      lengthIntegral   := 0.0;
      noOfEntries      :=   0;
      noOfDepartures   :=   0;
end; {of InitQueue procedure}

procedure aQueueType.Reset;
begin
     aSimObject.Reset;
     maxLength      :=   q.Card;    {current length}
     lengthIntegral := 0.0;
     noOfEntries    :=   0;
     noOfDepartures :=   0;
end;

function  aQueueType.length : INTEGER;         {Read-only determine length}
begin     length := Q.card    end;

procedure aQueueType.FileIntoFIFOq ( ta : aTAPtrType);
begin
      Q.tail_insert (ta);
      noOfEntries:= noOfEntries + 1;
      if traceFlag then
        begin
          WRITELN ('A TA enters queue at ',TheClock. NOW:8:2);
           WRITELN ('Its length is now     ', Q.Card:5);
         end;
      lengthIntegral := lengthIntegral + Q.card * (TheClock.NOW -
                     timeOfLastChange);
     timeOfLastChange:= TheClock.NOW;
end; { of FileIntoFIFOQ procedure }

function aQueueType.TakeFirstFromQ  : aTAPtrType;
var
  ta : aTAPtrType;
{FIFO queue! Remove transactions from head of queue. }
begin
  if Q.Card <= 0 then
    begin
      WRITELN ('Cant''t remove items from an empty queue!');
      TakeFirstFromQ := Nil;
    end
  else
    begin
       TakeFirstFromQ := aTAPtrType(Q.Get);
       noOfDepartures:= noOfDepartures + 1;
       if traceFlag then
        begin
            WRITELN ('A TA leaves queue at',TheClock.NOW:8:2);
            WRITELN ('Its length is now     ', q.Card: 5);
        end;
        lengthIntegral := lengthIntegral + q.Card * (TheClock.NOW -
                        timeOfLastChange);
       timeOfLastChange:= TheClock. NOW;
    end; {if}
end; { of TakeFirstFromFIFOQ function }

function aQueueType.MeanQlengthQ  : REAL;
begin
 if TheClock. NOW > 0 then
    MeanQlengthQ := lengthIntegral / (TheClock.NOW - startTime)
  else
   MeanQlengthQ := 0;
end;


function aQueueType.MaxQlengthQ : INTEGER;
begin
  MaxQlengthQ := maxLength;
end;

function aQueueType.MeanQdelayQ  : REAL;
begin
 if TheClock.NOW > 0 then
    MeanQdelayQ := lengthIntegral /  noOfDepartures
  else
   MeanQdelayQ := 0;
end;

procedure aQueueType.Report;
begin
  aSimObject.report; 
  WRITE   ( noOfEntries:5,  ' items');
  WRITELN (' entered and ');
  WRITELN (noOfDepartures:5, 'left the queue.');
  WRITELN ('Its current length is ', q.Card :5);
 WRITELN;
  WRITELN ('The queue''s main characteristics were: ');
 WRITELN ('- - - - - - - - - - - - - - - - - - - - ');
 WRITELN;
 WRITELN ('Mean length = ', MeanQlengthQ :5:2);
 WRITELN ('Max. length = ', MaxQlengthQ  :5  );
 WRITELN ('Mean delay  = ', MeanQdelayQ  :5:2);
end;

destructor aQueueType.destroy;
begin q.destroy end;


END.