unit resource;
{Part of simulation toolboxes,
 Author Lin Jensen
 Date   Nov. 12, 1996 }

{a resource has a capacity, and can be acquired and released
 by processes. It reports on its utilization (like a "server"),
 and possesses a queue at which processes await its availability.

 Processes can try to acquire any number of resource units up to the
 capacity, and they should eventually release the same number.

 THIS IMPLEMENTATION looks in its queue for the first process that
 can acquire all its requested units. It is up to the programmer using
 resources to beware of "starvation" of processes that demand larger
 number of units, because smaller requests can keep the resource
 occupied.

 You can guard against this, and make acquiring strictly FIFO by using
 a semaphore to allow only one process the right to acquire.

 For the special case of a single server, It would be possible to
 keep track of the current user, to ensure that the release comes from
 that one.

 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.

Two methods for acquiring (seizing) resources are implemented here.
    ACQUIRE doggedly waits for the resource.
    AcquireIfAvailable comes back with FALSE if the resource is unavailable
    or becomes so.

}

INTERFACE
USES Queue, SimObj, statObj, QnetObj, CoProc, Proc_man;

TYPE

aResource = object (aSimObject)                {is a Server with
                                               an implicit queue}
   constructor Init ( capacityP : INTEGER);
   procedure Reset;       virtual;

   procedure Acquire  ( howMuch : INTEGER);
   {will wait even for unavailable res. Can test, or use the following:}
   function AcquireIfAvailable  ( howMuch : INTEGER): BOOLEAN;
   {returns FALSE immediately if the resource is UNAVAILABLE (eg. broken)}
   procedure Release  ( howMuch : INTEGER);
             {A broken machine or absent store clerk is UNAVAILABLE}
   procedure MakeUnAvailable;
   procedure MakeAvailable;
   function  NotAvailable : boolean;    {is it currently unavailable to seize?}

   function  QueueLength : integer;  {length of waitqueue,
                                     negative for available capacity}
   {irrespective of "availability", use function NotAvailable if necessary}
   procedure Report ;      virtual;
   function  ServerUtilizationQ : REAL;
private
               server            : aServerType;
               waitqueue         : FifoQueue;
               waitstat          : measure;   {std. queue reporting}
               NumZeros          : integer;
               NumPassed         : integer;
               waitabit          : process;   {to delay the process that
                                              requests unavail}
               defersignal       : integer;   {defer signaling when unavail}
               UnitsIdle         : integer;
               morerequests      : semqueue;  {semaphore to control requests}
     procedure LetPass;
end; {aResource}


IMPLEMENTATION
TYPE
{queues used for resource waiting contain these records.
 Waiting procs will be suspended.}

UnitsPtr = ^UnitsItem;
UnitsItem = object (queueElement)
        proc : process;
        units: integer;
        stubborn : boolean;       {is stubborn waiting wanted???}
        constructor Init (p:process; howmany:integer; stubbornP:boolean);
        function equal  (old:ElementPtr): BOOLEAN; virtual;
    {to remove first item that can acquire all its units}
end;

constructor UnitsItem.Init (p:process; howmany:integer; stubbornP:boolean);
begin
   queueelement.init;
   proc := p;
   units := howmany;
   stubborn := stubbornP;
end;

function UnitsItem.equal  (old:ElementPtr): BOOLEAN;
begin
   equal := {test>unitsIdle} units >= UnitsPtr(old)^.units;
end;
    {to remove first item that can acquire all its units}


constructor aResource.Init ( capacityP : INTEGER);
begin
  if capacityP <= 0 then
   WRITELN ('Capacity must be > 0!')
  else
     begin
        aSimObject.Init ('resource');
        server.SubInit    (capacityP);
        waitqueue.Init;
        UnitsIdle :=   CapacityP;
        waitstat.SubInit;
        NumPassed := 0;
        NumZeros := 0;
        waitabit := Nil;
        Defersignal := 0;
        morerequests.init (1); {semaphore, allow only one request at a time}
     end;
end; {of InitServer procedure }

   procedure aResource.Reset;
   begin
      aSimObject.reset;
      server.reset;
      waitstat.reset;
      NumPassed := 0;
      NumZeros := 0;
   end;

procedure aResource.Acquire  ( howMuch : INTEGER);
   {will wait even for unavailable res. Can test, or use the following:}
var
   proxy : UnitsPtr;
begin
   if howmuch > server.CapacityQ then
        begin
           writeln ('ERROR, ',curproc^.name,' trying to acquire ',
                   howmuch, ' units from ',description,
                   ', whose capacity is ', server.capacityQ);
           EXIT;
        end;
   waitstat.update (1);
   if HowMuch > UnitsIdle then    {replaces semaphore VALUE}
     begin                        {need to wait}
       NEW (proxy, Init(curproc, HowMuch, true));
       waitqueue.Tail_insert (proxy);
       suspend;
     end
   else
     Inc (NumZeros);              {count of procs with zero-time waiting}

   waitstat.update (-1);
   Inc (numpassed);
   UnitsIdle := UnitsIdle - HowMuch;
   server.SeizeServer (HowMuch);
end;

function aResource.AcquireIfAvailable  ( howMuch : INTEGER): BOOLEAN;
{returns FALSE immediately if the resource is UNAVAILABLE (eg. broken),
 or if it becomes broken}
var
   proxy : UnitsPtr;
begin
   if howmuch > server.CapacityQ then
        begin
           writeln ('ERROR, ',curproc^.name,' trying to acquire ',
                   howmuch, ' units from ',description,
                   ', whose capacity is ', server.capacityQ);
           EXIT;
        end;
     
   if server.NotAvailable then
      acquireifAvailable := FALSE
   else
    begin
      {wait until the desired units are deemed available}
{Try to acquire. WAIT if necessary-----------------------------------}
   waitstat.update (1);
   if HowMuch > UnitsIdle then    {replaces semaphore VALUE}
     begin                        {need to wait}
       NEW (proxy, Init(curproc, HowMuch, false));
       waitqueue.Tail_insert (proxy);
       suspend;
     end
   else
     Inc (NumZeros);              {count of procs with zero-time waiting}
   waitstat.update (-1);
   Inc (NumPassed);
{------------------------ end of waiting -----------------------}
          if server.NotAvailable then       {server could have broken}
            begin
              acquireifAvailable := FALSE;
              Exit;
            end;
      UnitsIdle := UnitsIdle - HowMuch;
      server.SeizeServer (HowMuch);
      acquireifAvailable := TRUE;
    end;
end; {acquireIfAvailable}

procedure aResource.Release  ( howMuch : INTEGER);
{HowMuch should be same as used by the process in Acquire!!!!}
var
   count:integer;
begin
   {release the server-------}
      server.ReleaseServer (howmuch);

   {resume process that requested unavailability when it takes hold}
      if (server.stateQ = unavailable) AND
         (waitabit <> Nil) then
              begin
                   resume (waitabit);     {process that requested unavail
                                           will now progress}
                   waitabit := Nil;
              end;

   {--- SIGNAL to waiting processes ----}
      if server.NotAvailable then
         defersignal := defersignal + HowMuch  {signal done by MakeAvailable}
      ELSE
         begin
           UnitsIdle := UnitsIdle + HowMuch;
           LetPass;
         end;
end;

procedure aResource.MakeUnAvailable;
var
   x:integer;
   zombie : UnitsPtr;
begin
   morerequests.wait;                   {only one preemption at a time!}
   server.MakeUnavailable;

  {-- resume the "ifAvailable" processes, keep the stubborn ones --}
   for x := 1 to waitqueue.card do
     begin
       zombie := UnitsPtr(waitqueue.get);
       with zombie^ do
         if stubborn then
            waitqueue.tail_insert (zombie)
         else
           begin
            resume (proc);
            dispose (zombie, destroy);
           end;
     end;  {for}
                                {they must check server.NotAvail}
   defersignal := UnitsIdle;
   UnitsIdle := 0;              {close the semaphore}
   if server.stateQ = busy then
     begin                {wait until all current services finish}
       waitabit := curproc;
       suspend;
     end;
end;


procedure aResource.MakeAvailable;
var
   count:integer;
begin
   server.MakeAvailable;
      if   (waitabit <> Nil) then           {just in case still suspended}
                   resume (waitabit);     {process that requested unavail
                                           will now progress}
      waitabit := Nil;
   morerequests.signal;            {other procs might make it unavailable again}
   if not notavailable then
     begin
      UnitsIdle :=  defersignal;   {open the semaphore}
      LetPass;
     end;
end;

procedure aResource.LetPass;
{resume the first waiting process (if any) that can acquire its units}
var
   candidate : UnitsPtr;
   test      : UnitsPtr;
begin
 NEW (test, Init (Nil, UnitsIdle, true));  {specify UnitsIdle}
  candidate := UnitsPtr (waitqueue.remove (test));
  WHILE candidate <> NIL do
    begin
      resume (candidate^.proc);
      test^.units := test^.units - candidate^.units; {balance of units idle}
      dispose (candidate, destroy);
      candidate := UnitsPtr (waitqueue.remove (test));
    end;
 dispose (test, destroy);
end; {letpass}

function  aResource.NotAvailable : boolean;    {is it currently unavailable to seize?}
begin
   NotAvailable := server.NotAvailable;
end;

function  aResource.QueueLength : integer;  {length of waitqueue,
                                     negative for available capacity}
begin
  if server.NotAvailable then
     QueueLength := waitqueue.card
                    {no neg. for "unused"cap.}
  else
     QueueLength := waitqueue.card - UnitsIdle
                    {normal length for a semaphore}
end;

procedure aResource.Report ;
begin
    aSimObject.report;
    server.report;
    writeln ('------ processes waiting times: ----- for resource:');
    if not waitqueue.isEmpty then
       Writeln ( waitqueue.card, ' processes are waiting.');
    Writeln (NumPassed, ' processes have passed,');
    Write (Numzeros, ' of them with zero delay');
    IF NumPassed >= 1 then
        Write (' (',Numzeros/NumPassed*100:4:1,'%)');
    Writeln;
    waitstat.report;
    Writeln ('Mean Delay = ', waitstat.DelayQ :7:2);

 end;

function  aResource.ServerUtilizationQ : REAL;
begin
    serverutilizationq := server.ServerUtilizationQ
end;


end.