{ unit for implementing co-procedures (co-routines) in a Pascal simulation
           environment, Object Oriented Turbo Pascal 6.0}

{ THIS UNIT is the PROCESS MANAGER   }

{ Author : Lin Jensen
  Date   : Feb. 10, 1991 }
{ Rev.   : Mar.  5, 1991, report on fate of living processes at end of sim}
{ Rev.   : Mar. 20, 1991,  to match change of process as fully object-oriented}
{ Rev.   : Oct. 5, 1996, to incorporate simulation objects with global reporting}

UNIT PROC_MAN;
INTERFACE
USES COPROC, QUEUE, CLOCK, SIMOBJ, STATOBJ;

{  ===================================================================
        COPROC has THE BASIC CONTEXT SWITCH ROUTINES.  
        QUEUE  implements generic linked list FIFO queues

   Further utilities include a monitor for scheduling processes, using a 
   ready queue (FIFO), a sleep queue (ordered by simulated-time wakeup),
   Semaphores, and message passing primitives.
  
========================================================================== }

TYPE

{==========================================================================}
{                                                                          }
{ !!!!! IMPORTANT queue must give a pointer to elements of the appropriate }
{ --------------- element object, to do this, redefine access pointer type }
{                                                                          }
{==========================================================================}

    queuedescr = OBJECT (fifoqueue)
       function     Get     : process ;       {also removes from q }
       {redefine method to give a pointer to PCB}
    end;

{==========================================================================}
{                                                                          }
{ A semaphore queue also has a counter of processes that can pass without  }
{ --------------------------------------------------------------  waiting  }
{==========================================================================}

    semaphore = ^semqueue;
    semqueue = OBJECT (aSimObject)
        PQ    : queuedescr;        {queue of blocked processes}
        value : WORD ;
        stat  : measure;
        NumPassed : integer;     {number passed semaphore}
        Number_zeros: integer;   {number passed with zero delay}
        constructor init ( initialcapacity : WORD );    {redefine method}
        constructor SubInit ( initialcapacity : WORD );
        procedure wait  ;                               {new methods}
        procedure signal;
        function length: integer;       {how many processes are waiting}
                                  {a negative value indicates unused capacity}
        procedure reset;   virtual;     {reset asociated statistics}
        procedure report;  virtual;     {report on queue length stats.}
        destructor dissolve;
    end;

{==========================================================================}
{                                                                          }
{ A sleep     queue also has a method to insert process by time order      }
{==========================================================================}

   sleepqueuedescr = OBJECT (orderedList)
        function     Get     : process ;       {also removes from q }
       {redefine method to give a pointer to PCB}
   end;

{==========================================================================}

   MONITOR_T = OBJECT(aSimObject)      {obj. for controlling termination}
        reportFlag    : BOOLEAN;  {default TRUE, report on processes at end}
      SamplesTaken  : WORD;          
      SamplesToTake : WORD;      {fields initialized by RunSimulation }
      TimeToStop    : REAL;
      constructor Init;
      procedure RecordSample;   {method to increment sample count}
      procedure reset;    virtual;
      procedure report;    virtual;
(*    procedure Trace;         {toggle traceFlag}
      procedure UnTrace;                         *)
      procedure NoProcessReport; {turn off reportFlag}
      procedure RUNSIMULATION (SimLength : REAL; SampleSize : WORD);
               {run the simulation using co-processes until time
                or number of samples expires}
      function KeepGoing:Boolean;    {test of samples and time limit}
   private
      function EnoughSamples : BOOLEAN;    {used by reschedule}
   end;

{======================== process self-identification =====================}

function GetPid : process;   {get pointer to own process control block}
function GetName : pname;    {get process'es name - a string}
function GetNumber: integer;    {get process'es numeric index}
                    {can use to index table of neighbors}

{================== other process control primitives  =====================}

procedure SUSPEND;      {suspend yourself}

procedure DEFER;        {still ready, run after first sleeping process}

procedure RESUME (friendly : process);     {make ready a SUSPENDED process}

procedure SLEEP_For   (period  : REAL);        {Increment of time to sleep}
procedure SLEEP_Until (morning : REAL);
             {calling process goes on sleep queue till morning wakeup time}

procedure TERMINATE;    {terminate yourself}



VAR
   MONITOR : monitor_t;         {initialized by runsimulation}

{==========================================================================}

IMPLEMENTATION
VAR

{--- here is where processes live.  The running process has the CPU, and }

   readyqueue : queuedescr;     {processes that are ready to run NOW }
   deferqueue : queuedescr;     {processes waiting until the clock advances}
   sleepqueue : sleepqueuedescr;     {processes with a wakeup time}

 { in addition, there will be semaphore queues, dynamically allocated }
 { processes may also be suspended, awaiting a resume from another process }

{ =================== PROCESS MANAGEMENT ROUTINES ======================== }

procedure monitor_t.reset;
begin
    aSimObject.reset;
    WRITELN    (', after ', SamplesTaken, ' samples were taken!');
    SamplesTaken := 0;  {probably redundant with runsimulation}
end;

function Monitor_t.EnoughSamples : BOOLEAN;    {used by reschedule}
begin
    EnoughSamples := SamplesTaken >= SamplesToTake
end;

procedure RESCHEDULE;    {reschedule processor to the first process on the }
                         { ready queue, or else the sleep queue,           }
                         { which advances the clock }
var
    prevproc : process;
begin
    curproc^.since := TheClock.TellTime;    {for reporting}
                    {any process entering a new state passes through reschedule}
                    {or is RESUMEd or unBlocked }
    if monitor.traceFlag then
        curproc^.report;
    prevproc := curproc;
    if Monitor.EnoughSamples then
        curproc := main                     {END SIMULATION ON SAMPLE COUNT}
    else if NOT readyqueue.IsEmpty  then
        curproc := readyqueue.Get   
    else if NOT sleepqueue.IsEmpty then
      begin
        curproc := sleepqueue.Get ;
        TheClock.AdvanceTo (curproc^.Wakeup) ;    {ONLY PLACE TIME PASSES}

        IF TheClock.TellTime > Monitor.TimeToStop then
          begin
           curproc^.status := ready;
           readyqueue.tail_insert(curproc); {It is now ready for next runs.}
           curproc := main;                 {END SIMULATION AT SCHEDULED TIME}
          end                           {note: in this case deferqueue stays deferred}
        ELSE
          begin
           readyqueue := deferqueue ;           {defered processes become ready}
           deferqueue.Init ;                    {defer queue is now empty }
          end;
      end
    else if NOT readyqueue.IsEmpty  then     {we expect deferqueue was empty, }
        curproc := readyqueue.Get          {but this is one last chance to act}
    else
      begin
        curproc := main ;       {no more processes can run, end simulation}
        WRITELN ('NO MORE PROCESSES TO RUN AT ', TheClock.TellTime:8:2);
      end;

    curproc^.status := running;
    if monitor.traceFlag and (curproc<>main) then
        curproc^.report;
    if curproc <> prevproc then     {perhaps no context switch needed}
        TRANSFER (prevproc, curproc);
end; {reschedule}

{======================== process self-identification =====================}

function GetPid : process;   {get pointer to own process control block}
begin
    GetPid := curproc;
end;

function GetName : pname;    {get process'es name - a string}
begin
    GetName := curproc^.name;
end;

function GetNumber: integer;    {get process'es numeric index}
                    {can use to index table of neighbors}
begin
    GetNumber := curproc^.index;
end;

{================== other process control primitives  =====================}

procedure SUSPEND;      {suspend yourself}
begin
    curproc^.status := suspended;
    reschedule;
end;     {suspend}

procedure DEFER;        {still ready, run after first sleeping process}
begin
   curproc^.status := ready;
   deferqueue.tail_insert(curproc);
   reschedule;
end;      {defer}

procedure RESUME (friendly : process);  {make ready a SUSPENDED process}
{does not interrupt the current process}
begin
    with friendly^ do
      begin
        if status = ready then
          begin
            curproc^.status := ready;
            readyqueue.tail_insert (curproc);    {signalling process still ready}
            reschedule;                       {break atomicity.
                                        reason: friendly may be trying to
                                        suspend itself right now}
          end;
        if status = suspended then begin
            status := ready;
            since  := TheClock.TellTime;     {record time of state change}
            if monitor.traceFlag then 
              begin
                Write ('== Resume');
                friendly^.report
              end;
            readyqueue.tail_insert (friendly);
          end
        else
         { if monitor.traceflag then  -- always report this possible error}
            begin
               write ('** OOPS, not suspended, Can''t resume');
               friendly^.report;
            end;
      end;  {with friendly}
end;     {resume}

procedure SLEEP_For (period : REAL);
begin
    SLEEP_UNTIL (TheClock.TellTime + period)
end;

procedure SLEEP_Until (morning : REAL);
             {calling process goes on sleep queue till morning wakeup time}
begin
    with curproc^ do
      begin  
        WakeUp := morning;
        status := sleeping;
      end;
    sleepqueue.insert (curproc);
    reschedule;
end;    {sleep}

procedure TERMINATE;    {terminate yourself}
{the trick here is that we need to schedule a DELAYED release of space}
begin
    processlist.erase (curproc);     {no longer keep record for report}
    curproc^.status := terminated;   {mark for destruction to be done }
    reschedule;                      {  in TRANSFER after stack switch }
end;    {terminate}

{======================  SEMAPHORE METHODS ===========================}

constructor semqueue.init ( initialcapacity : WORD );    {redefine method}
begin
    aSimObject.Init ('semaphore queue');
    PQ.Init;
    value := initialcapacity;
    stat.SubInit;
    stat.SpecificLabel ('semaphore');
    NumPassed := 0;
    Number_Zeros := 0;
end;

constructor semqueue.SubInit ( initialcapacity : WORD );    {redefine method}
begin
    aSimObject.SubInit ('semaphore queue');
    PQ.Init;
    value := initialcapacity;
    stat.SubInit;
    stat.SpecificLabel ('semaphore');
    NumPassed := 0;
    Number_Zeros := 0;
end;

procedure   semqueue.wait ;                         
{---- standard implementation.  
               - process may wait for access to a critical section }
begin
    if value > 0 then
      begin
         value := value - 1;    {pass the semaphore}
         stat.update(1) ;
         stat.update(-1) ; {record passage}
         inc (NumPassed);
         inc (number_zeros);    {this process had zero wait time}
      end
    else
      begin
        curproc^.status := blocked;
        stat.update (1);
        PQ.tail_insert (curproc);                {wait at the semaphore}
        reschedule;
      end;
end;

procedure   semqueue.signal;
{ standard implementation. - a running process which is leaving a critical
                             section lets another pass the semaphore }
var
    readyproc : process;
begin
    if PQ.IsEmpty then
        value := value + 1
    else
      begin
        readyproc := PQ.Get ;                  {let first process on queue pass}
        readyproc^.status := ready;         {make it ready}
        readyproc^.since  := TheClock.TellTime;    {record time of state change}
        readyqueue.tail_insert (readyproc);  {put it on ready queue}
        if monitor.traceFlag then 
          begin
            Write ('== Pass Semaphore');
            readyproc^.report
          end;
        stat.update (-1);
        Inc (NumPassed);
        curproc^.status := ready;
        readyqueue.tail_insert (curproc);    {signalling process still ready}
        reschedule;                     {break atomicity of signalling process}
                                        {defers to monitor}
      end;
end;

function semqueue.length: integer;     {length of queue of blocked processes}
begin
  if value > 0 then
   length := - value    {some processes can pass without waiting}
  else
   length := PQ.card;
end;

procedure semqueue.reset;
begin
   aSimObject.reset;
   stat.reset;
   NumPassed := 0;
   Number_Zeros := 0;
end;

procedure semqueue.report;
begin
    aSimObject.report;
    Write ('This semaphore  ');
    if PQ.isEmpty then
       Writeln ('is open for ',value, ' to pass')
    else
       Writeln ('has ', PQ.card, ' waiting processes.');
    Writeln (NumPassed, ' processes have passed,');
    Write (Number_zeros, ' of them with zero delay');
    IF NumPassed >= 1 then
        Write (' (',Number_zeros/NumPassed*100:4:1,'%)');
    Writeln;
    stat.report;
    Writeln ('Mean Delay = ', stat.DelayQ :7:2);
end;

destructor  semqueue.dissolve;
{free up the waiting processes, by putting them back on the ready queue}
begin
    while not PQ.IsEmpty do
        signal;
    aSimObject.Destroy;                  {no more can there be a report!}

end;

{  =====================  SLEEP QUEUE  METHODS =========================== }

{ ==== ordered list insert uses this function to determine time ordering }


function   SleepQueuedescr. Get     : process ;       {also removes from q }
       {redefine method to give a pointer to PCB}
begin
     Get := process(orderedList.get)
end;

{==========================================================================}

function   Queuedescr. Get     : process ;       {also removes from q }
       {redefine method to give a pointer to PCB}
begin
     Get := process(fifoqueue.get)
end;

{==========================================================================}

constructor Monitor_t.Init;
begin
   aSimObject.Init ('process scheduling monitor');
    Monitor.ReportFlag := TRUE;
end;

procedure Monitor_t.RecordSample;
begin
    SamplesTaken := SamplesTaken + 1
end;

procedure Monitor_t.NoProcessReport; {turn off reportFlag}
begin
   ReportFlag := FALSE;
   Writeln ('--- Report on processes has been DISABLED ---');
end;

{======================================================================}

procedure Monitor_t.Report;
{report on the surviving processes. }
var
   this : plistelemptr;    {go through list of processes}
begin
    IF not ReportFlag then EXIT;
    aSimObject.report;
    Write ('Simulation stopped at '); TheClock.rite;
    Writeln ( ' after ', samplestaken, ' samples recorded.');
    Writeln ('===============================================================');
    Writeln ( processlist.termcount :7, '  Processes have terminated.            Ready: ', readyqueue.card);
    Writeln ( processlist.CARD      :7, '  Processes survive.  They are:      Deferred: ', deferqueue.card);
    this := plistelemptr(processlist.pop);
    processlist.Push (this);            {make current procedure non-destructive}
    while this <> Nil do
      begin
        this^.proc^ . Report ;          {Writes a line for each process in list}
        this := plistelemptr(this^.next)
      end; {while}
    Writeln ('---------------- End of Process Report ------------------------');
    Writeln;
end;  {ReportOnProcesses}

{==========================================================================}

procedure Monitor_t.RUNSIMULATION (SimLength : REAL; SampleSize : WORD);
{run the simulation using co-processes until time or number of samples expires}
begin
{   with MONITOR do begin    }               {set termination conditions}
        SamplesTaken := 0;
        SamplesToTake := SampleSize;
        TimeToStop    := SimLength;
{    end;}
         main^.status := suspended;
         curproc := main;
         reschedule;
{ -- control returns here from reschedule when simulation is finished --}
        {if ReportFlag then report;}
end; {runsimulation}

function Monitor_T.KeepGoing : boolean;
begin
   KeepGoing := NOT Monitor.enoughSamples and
         ( TheClock.TellTime < Monitor.TimeToStop)
end;

{==========================================================================}

BEGIN   { --- INITIALIZATION --- }
    readyqueue.Init;   {all queues are initially empty}
    deferqueue.Init;
    sleepqueue.Init;
{trace and report options, can be overridden by user }
    Monitor.Init;

END.    {PROCESS MANAGER - PROC_MAN}