Power-Programmierung/CD1.mdf/modula2/library/queuem2/queuexam.mod

Text File | 1989-08-30 | 31KB | 875 lines

(* source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22
   author: G.Greene, AGCS D/429 (NS/TS), 312/681-7783       created: 88.07.22

   function:
    This is a test program for module QueueADT, and of the random variate
    generators used.  Because it makes use of many Modula-2 language features,
    this program can also be used as part of an evaluation of Modula-2
    systems.  This version is customized for the JPI TopSpeed compiler and
    module libraries.

   history:
    88.07.22  1.0a  initial release.
*)

MODULE  QueuExample;


FROM  IO        IMPORT  (*PROC*)  WrLn,  WrStr,  RdStr,  WrCard,  RdCard,
                                  WrLngCard,  RdReal,  WrReal,
                                  RedirectInput,  KeyPressed,  RdKey;

FROM  Str       IMPORT  (*PROC*)  FixRealToStr;

FROM  GetRange  IMPORT  (*PROC*)  GetLimitedCARDINAL, GetPositiveREAL;

FROM  QueueADT  IMPORT  (*TYPE*)  Queues,
                        (*PROC*)  CreateQueue,  EmptyTheQueue,  DestroyQueue,
                                  isEmpty, QueueSize,
                                  FIFOEnqueue,  PriorityEnqueue,
                                  Dequeue, ReadElement;

FROM  MakeSeed  IMPORT  (*PROC*)  MakeSeedValue;

FROM  UnifRNG   IMPORT  (*PROC*)  SetSeedValue;

FROM  NormRNG   IMPORT  (*PROC*)  NormalVariate,
                                  LognormalVariate, LognormalParameters;

FROM  XpnlRNG   IMPORT  (*PROC*)  ExponentialVariate;

FROM  QueData   IMPORT  (*CONST*) MaxQueues,   MaxServers,
                        (*TYPE*)  ServiceFunctions,  ProcessTimes,
                                  QueueEntryData,
                                  QueueListIndices,  ServerListIndices,
                                  QueueInfo,   ServerInfo,
                                  QueueLists,  ServerLists;

FROM  QueDsply  IMPORT  (*TYPE*)  DisplayActions,  MessageTypes,
                        (*PROC*)  DisplayStatusMatrix,
                                  ChangeQueueDisplay,  ChangeServerDisplay,
                                  DisplayMessage,  DisplayCurrentTime,
                                  DisplaySummary;

FROM  Window    IMPORT  (*PROC*)  Clear,  GotoXY;

FROM  Lib       IMPORT  (*PROC*)  Delay;


TYPE
  ServerNumbers     = [ 0 .. MaxServers ];

(*                                                                        [2]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


VAR
  EventQueue:       Queues;            (* priority queue of pending events *)
  QueueList:        QueueLists;        (* information about each queue *)
  ServerList:       ServerLists;       (* information about each server *)

  NumberOfQueues:   QueueListIndices;  (* number of queues actually allocated *)

  OverloadedQueues: BITSET;            (* set of overloaded queue numbers *)

  IsIndependentRun: BOOLEAN;           (* true, if we start at random *)

  (* the following are process parameters in arbitrary time units *)
  SimulationPeriod:  ProcessTimes;     (* time limit for simulation *)

  ArrivalIntervalEV: REAL;             (* expected inter-arrival time value *)



(* Ask the operator for process parameters (whether this should be independent
   of other runs, the arrival and service rates, and the number of time units
   to run the process).
*)

PROCEDURE  GetProcessParameters (
                   (*out*)  VAR  IsIndependentRun:  BOOLEAN;
                   (*out*)  VAR  SimulationPeriod:  ProcessTimes;
                   (*out*)  VAR  ArrivalIntervalEV: REAL );
  VAR
    YesOrNo: ARRAY [ 0 .. 0 ]  OF CHAR;   (* one-byte string: "Y" or "N" *)

  BEGIN
    WrLn;
    WrStr ( "Do you want this run to be independent (Y/[N])? " );
    RdStr ( YesOrNo );
    IsIndependentRun := CAP ( YesOrNo [ 0 ] ) = "Y";
    WrLn;
    WrStr ( "The following questions assume a common time unit." );
    WrLn;
    WrStr ( "You may use any reasonable unit (seconds, minutes, etc.)," );
    WrLn;
    WrStr ( "but you must use that unit consistently." );
    WrLn;    WrLn;

    WrStr ( "How long (in your time units) do you want this to run?" );
    WrLn;
    WrStr ( "Your answer must be a positive integer value: " );
    SimulationPeriod := RdCard ( );
    WrLn;

    ArrivalIntervalEV := GetPositiveREAL (
      "What is the mean customer arrival rate (time units between customers)?",
       FALSE (* zero is not allowed *) );
  END  GetProcessParameters;

(*                                                                        [3]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* Get a valid number of queues to simulate from the operator, and return
   that value in the parameter.  Allocate that many queues, and get the
   queue-related information from the operator for each of the allocated
   queues.  Also allocate the (priority) event queue for internal use in
   this program.
*)

PROCEDURE  SpecifyQueues (
            (*out*)  VAR  QueueCount: QueueListIndices );

  VAR
    QueueIndex:     QueueListIndices;
    CustomerSink:   CARDINAL;

(*                                                                        [4]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* Define the service time probability distribution for the queue specified
   by the parameter.  In addition to choosing the type of distribution, the
   operator is prompted for the parameters of the chosen distribution.
*)

  PROCEDURE  GetServiceParameters (
                           (*in*)  inQueue: QueueListIndices );

    VAR
      Answer:         ARRAY [ 0 .. 0 ]  OF CHAR;
      FunctionCode:   CHAR;
      ServiceStdDev:  REAL;


    BEGIN
      QueueList [ inQueue ] .ServiceTimeEV := GetPositiveREAL (
           "  What is the mean customer service time (time units/customer)?",
            FALSE  (* zero is not allowed *) );

      WrStr ( "  What is the service time probability distribution?" );
      WrLn;
      WrStr ( "  ... specify eXponential, Normal, or [L]ognormal: " );
      RdStr  ( Answer );   WrLn;
      FunctionCode := CAP ( Answer [ 0 ] );

      WITH  QueueList [ inQueue ]  DO
        IF  ( FunctionCode = 'X' )  OR  ( FunctionCode = 'E' )  THEN
          ServiceFcn   := Exponential;
          ServiceParm1 := ServiceTimeEV;

        ELSE
          ServiceStdDev := GetPositiveREAL (
                           "  What is the standard deviation of service time?",
                            TRUE  (* zero allowed *) );

          IF  FunctionCode = 'N'  THEN
            ServiceFcn   := Normal;
            ServiceParm1 := ServiceTimeEV;
            ServiceParm2 := ServiceStdDev;

          ELSE   (* assume default: lognormal *)
            ServiceFcn   := Lognormal;
            LognormalParameters ( ServiceTimeEV,  ServiceStdDev,
                                  ServiceParm1,   ServiceParm2 );
          END;
        END;   (* IF exponential *)
      END;   (* WITH *)
    END  GetServiceParameters;

(*                                                                        [5]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


  BEGIN    (* SpecifyQueues *)
    CreateQueue ( EventQueue );
    QueueCount := GetLimitedCARDINAL ( 1,  MaxQueues,
                                       "Enter number of queues to allocate, " );

    FOR  QueueIndex := 1  TO  QueueCount  DO
      QueueList [ QueueIndex ] .ExternalInput := TRUE;
    END;

    FOR  QueueIndex := 1  TO  QueueCount  DO
      WITH  QueueList [ QueueIndex ]  DO
        CreateQueue ( theQueue );
        CurrentSize := 0;    TotalWait := 0;    SinkOutputTo := 0;

        WrLn;   WrStr ( "Please enter information for queue #" );
        WrCard ( QueueIndex, 1 );   WrStr ( ": " );   WrLn;

        ServerCount := GetLimitedCARDINAL ( 1, MaxServers,
                                            "  Number of servers " );

        GetServiceParameters ( QueueIndex );

        IF  QueueIndex = QueueCount  THEN
          SinkOutputTo := 0;   (* last queue must release customer *)

        ELSE                   (* ask operator where customers go *)
          REPEAT
            WrStr  ( "  What is the customer sink (zero, or queue # " );
            WrCard ( QueueIndex + 1, 1 );   WrStr ( "-" );
            WrCard ( QueueCount, 1 );       WrStr ( ")? " );
            CustomerSink := RdCard ( );     WrLn;
          UNTIL  ( CustomerSink = 0 )  OR
                 ( CustomerSink <= QueueCount )  AND
                                               ( CustomerSink > QueueIndex );
          SinkOutputTo := CustomerSink;

          IF  CustomerSink # 0  THEN
            QueueList [ CustomerSink ] .ExternalInput := FALSE;
          END;   (* IF sink to later queue *)
        END;   (* IF last queue *)
      END;   (* WITH queue info *)
    END;   (* FOR each queue *)
  END  SpecifyQueues;

(*                                                                        [6]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* Initialize the statistics for every server in each allocated queue.  The
   number of queues is specified by the parameter.
*)

PROCEDURE  InitializeServers (
                      (*in*)  QueueCount:  QueueListIndices );

  VAR
    QueueIndex:     QueueListIndices;
    ServerIndex:    ServerListIndices;

  BEGIN
    FOR  QueueIndex := 1  TO  QueueCount  DO
      FOR  ServerIndex := 1  TO  QueueList [ QueueIndex ] .ServerCount  DO
        WITH  ServerList [ QueueIndex, ServerIndex ]  DO
          TotIdleTime := 0;
          CustomerCnt := 0;
          IdleNow     := TRUE;
          IdleSince   := 0;
        END      (*WITH ServerList[QueueIndex,ServerIndex] *)
      END;    (* FOR each server *)
    END;    (* FOR each queue *)
  END  InitializeServers;

(*                                                                        [7]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* Display the parameters specified by the user, and check for consistency,
   etc.  At the moment, we only warn if one or more of the queues are
   overloaded (we expect customers to arrive faster than they can be served).
*)

PROCEDURE  TestParameters ( );


  VAR
    QueueIndex:  QueueListIndices;
    ArrivalRate: ARRAY QueueListIndices  OF REAL;  (* customers/time unit *)
    ServiceRate: REAL;                             (* customers/time unit *)
    LoadRatio:   REAL;                             (* arrival/service rates *)
    StringOfReal: ARRAY [ 0 .. 7 ]  OF CHAR;
    OK:           BOOLEAN;


(* Like the math MIN function, return the lesser of the two parameter values.
*)

  PROCEDURE  MinREAL (
              (*in*)  Value1, Value2: REAL ): REAL;

    BEGIN
      IF  Value1 < Value2
        THEN  RETURN  Value1;
        ELSE  RETURN  Value2;
      END;
    END  MinREAL;

(*                                                                        [8]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


  BEGIN  (* TestParameters *)
    WrStr ( "The parameters for this run are:" );   WrLn;
    WrStr ( "  Number of queues: " );    WrCard ( NumberOfQueues, 1 );
    WrLn;

    WrStr ( "  Mean arrival rate: " );
    FixRealToStr ( LONGREAL ( ArrivalIntervalEV ), 0, StringOfReal, OK );
    WrStr ( StringOfReal );
    WrLn;

    WrStr ( "  The simulation will proceed for " );
    WrCard   ( SimulationPeriod, 1 );    WrStr ( " time units." );
    WrLn;

    WrLn;

    (* initially set arrival rates for just external customer arrivals *)
    FOR  QueueIndex := 1  TO  NumberOfQueues  DO
      IF  QueueList [ QueueIndex ] .ExternalInput
        THEN  ArrivalRate [ QueueIndex ] := 1.0 / ArrivalIntervalEV;
        ELSE  ArrivalRate [ QueueIndex ] := 0.0;
      END;   (* IF external input *)
    END;   (* FOR each queue *)

    (* evaluate service rate vs. expected input rate *)
    OverloadedQueues := { };

    FOR  QueueIndex := 1  TO  NumberOfQueues  DO
      WITH  QueueList [ QueueIndex ]  DO
        ServiceRate := FLOAT ( ServerCount ) / ServiceTimeEV;

        IF  SinkOutputTo # 0  THEN
          ArrivalRate [ SinkOutputTo ] := ArrivalRate [ SinkOutputTo ]  +
                        MinREAL ( ArrivalRate [ QueueIndex ], ServiceRate );
        END;   (* IF *)

        (* warn if we expect to serve customers no quicker than they arrive *)
        LoadRatio := ArrivalRate [ QueueIndex ] / ServiceRate;

        IF  LoadRatio  >=  1.0  THEN
          WrStr ( "WARNING:  queue #" );   WrCard   ( QueueIndex, 2 );
          WrStr ( " is overloaded, ratio: " );
          FixRealToStr ( LONGREAL ( LoadRatio ), 2, StringOfReal, OK );
          WrStr ( StringOfReal );   WrLn;

          INCL ( OverloadedQueues, QueueIndex );
        END;   (* IF *)
      END;   (* WITH queue info *)
    END;   (* FOR each queue *)
  END  TestParameters;

(*                                                                        [9]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* Return TRUE if the user of this program responds positively to the question
   posed below.  A positive response is to press the "Y" key (upper- or lower-
   case).
*)

PROCEDURE  OperatorApproves ( ): BOOLEAN;

  VAR
    YesOrNo:  ARRAY [ 0 .. 0 ]  OF CHAR;
    Answer:   CHAR;

  BEGIN
    WrStr ( "Do you want to proceed with the emulation (Y/N)? " );
    RdStr ( YesOrNo );
    Answer := CAP ( YesOrNo [ 0 ] );

    RETURN  Answer = 'Y';
  END  OperatorApproves;

(*                                                                       [10]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* This is the main processing procedure of this program.  It runs a queue
   simulation in accordance with the user-provided specifications.
*)

PROCEDURE  RunTheSimulation ( );


  CONST
    SentinelValue  = 32769;   (* used to check priority queue integrity *)


  TYPE
    EventTypes     = ( CustomerArrives, ServerFinishes );

    Events =
      RECORD
        Time:    ProcessTimes;       (* this field MUST be first *)
        inQueue: QueueListIndices;

        CASE  Type: EventTypes  OF
          CustomerArrives:
              ServiceTime:  ProcessTimes;  (* interval, NOT starting clock *)
        |
          ServerFinishes:
              Server:       ServerListIndices;
        END;

        Sentinel: CARDINAL;
      END;   (* RECORD Events *)


  VAR
    CurrentTime:  ProcessTimes;      (* elapsed (clock) time since we began *)

    NextQueue:    QueueListIndices;

    NextEvent:    Events;
    DataIsValid:  BOOLEAN;

    ServiceParm1,
    ServiceParm2: REAL;       (* parameters for lognormal variate generator *)

(*                                                                       [11]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* Return as the function value a time interval randomly chosen for the
   service time distribution specified for the queue designated by the
   parameter (whew!).  Note that for the normal distribution, we have to
   provide for the possibility that a negative value will be generated.
   We do this by truncating the distribution at zero.
*)

  PROCEDURE  ServiceTimeFor (
                     (*in*)  QueueNumber: QueueListIndices ):  CARDINAL;

    VAR
      Value:  LONGREAL;

    BEGIN
      WITH  QueueList [ QueueNumber ]  DO
        CASE  ServiceFcn  OF
          Exponential:
            RETURN  TRUNC ( 0.5  +  ExponentialVariate ( ServiceParm1 ) );
        |
          Lognormal:
            RETURN  TRUNC ( 0.5  +
                            LognormalVariate ( ServiceParm1, ServiceParm2 ) );
        |
          Normal:
            Value := NormalVariate ( ServiceParm1, ServiceParm2 );

            IF  Value <= 0.0
              THEN  RETURN  0;
              ELSE  RETURN  TRUNC ( 0.5 + Value );
            END;   (* IF *)
        END;   (* CASE ServiceFcn *)
      END;   (* WITH queue info *)
    END  ServiceTimeFor;



(* Return as the function value a time interval randomly chosen for the
   arrival time distribution (forced to be exponential).
*)

  PROCEDURE  ExternalArrivalInterval ( ):  ProcessTimes;

    VAR
      Value:  REAL;

    BEGIN
      RETURN  TRUNC ( 0.5  +  ExponentialVariate ( ArrivalIntervalEV ) );
    END  ExternalArrivalInterval;

(*                                                                       [12]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* Set the simulation starting time to zero.  We first compute the parameters
   to be used by the service-time distribution.  Then, for each queue, we set
   its length to zero.  We determine when the first customer will arrive, and
   set the queue information record accordingly.  We also create event queue
   entries for each of the arrivals.  Along the way, we compute values of the
   parameters for the service interval distribution.
*)

  PROCEDURE  SetInitialState ( );

    VAR
      QueueIndex: QueueListIndices;
      Server:     ServerListIndices;
      event:      Events;

    BEGIN
      IF  IsIndependentRun  THEN
        SetSeedValue ( MakeSeedValue ( ) );
      END;

      CurrentTime     := 0;
      event .Type     := CustomerArrives;
      event .Sentinel := SentinelValue;

      FOR  QueueIndex := 1  TO  NumberOfQueues  DO
        FOR  Server := 1  TO  QueueList [ QueueIndex ] .ServerCount  DO
          ChangeServerDisplay ( QueueIndex, Server, Unmark );
        END;

        IF  QueueList [ QueueIndex ] .ExternalInput  THEN
          WITH  event  DO
            Time        := ExternalArrivalInterval ( );
            inQueue     := QueueIndex;
            ServiceTime := ServiceTimeFor ( QueueIndex );
          END;   (* WITH event *)

          PriorityEnqueue ( event, EventQueue );
        END;    (* IF customers originate outside *)
      END;    (* FOR each queue *)

      IF  OverloadedQueues # { }  THEN
        DisplayMessage ( WarningMessage, "Overloads:" );

        FOR  QueueIndex := 1  TO  NumberOfQueues  DO
          IF  QueueIndex IN OverloadedQueues  THEN
            WrCard ( QueueIndex, 3 );
          END;    (* IF overloaded *)
        END;    (* FOR each queue *)
      END;    (* IF any queue is overloaded *)
    END  SetInitialState;

(*                                                                       [13]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* Examine all servers in the queue specfied by the first parameter.  If any
   of them are idle, return the index to the server that has been idle longest
   in the second parameter, and return TRUE as the function value.  If there
   are no idle servers, return FALSE.
*)

  PROCEDURE  FoundIdleServer (
                 (*in*)       inQueue:      QueueListIndices;
                (*out*)  VAR  ServerToUse:  ServerListIndices ): BOOLEAN;

    VAR
      EarliestIdle:  CARDINAL;
      ServerIndex:   ServerListIndices;
      HaveServer:    BOOLEAN;

    BEGIN
      EarliestIdle := MAX ( CARDINAL );      (* actual values will be <= this *)
      HaveServer   := FALSE; (* set TRUE if any server for this queue is idle *)

      FOR  ServerIndex := 1  TO  QueueList [ inQueue ] .ServerCount  DO
        WITH  ServerList [ inQueue, ServerIndex ]  DO
          IF  IdleNow  AND  ( IdleSince <  EarliestIdle )  THEN
            EarliestIdle := IdleSince;
            ServerToUse  := ServerIndex;
            HaveServer   := TRUE;
          END;
        END;   (* WITH ServerList[inQueue,ServerIndex] *)
      END;   (* FOR ServerIndex *)

      RETURN  HaveServer;
    END  FoundIdleServer;

(*                                                                       [14]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(*  Set the server specified by the second parameter in the queue specified
    by the first parameter active for the time interval specified by the
    third parameter.  Then enqueue an event to signal the server's completion.
*)

  PROCEDURE  ActivateServer (
                     (*in*)  QueueNumber:   QueueListIndices;
                     (*in*)  ServerNumber:  ServerListIndices;
                     (*in*)  ServiceTime:   ProcessTimes );

    VAR
      event:  Events;  (* priority queue event: server becomes free *)


    BEGIN   (* ActivateServer *)
      WITH  ServerList [ QueueNumber, ServerNumber ]  DO
        INC ( TotIdleTime, CurrentTime - IdleSince);

        INC ( CustomerCnt );

        IdleNow    := FALSE;
        myCustomer .ServiceTime := ServiceTime;
        myCustomer .StartTime   := CurrentTime;
      END;   (* WITH Server *)

      event .Time     := CurrentTime + ServiceTime;
      event .inQueue  := QueueNumber;
      event .Type     := ServerFinishes;
      event .Server   := ServerNumber;
      event .Sentinel := SentinelValue;

      PriorityEnqueue ( event, EventQueue );
    END  ActivateServer;

(*                                                                       [15]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* The first parameter contains the event queue entry for a customer arrival.
   If there is any idle server for the queue associated with this event, we
   immediately assign the customer to that server;  otherwise, we must add it
   to the queue.  It will then be processed after n ServerFinishes events
   occur for that queue, where n is the queue length.  The second parameter
   has the starting time to assign to the customer (CurrentTime for external
   customers, or the original start time for those transferred from another
   queue).
*)

  PROCEDURE  AssignCustomer (
                     (*in*)  NextEvent: Events;
                     (*in*)  StartTime: ProcessTimes );

    VAR
      QueueEntry:   QueueEntryData;
      QueueToUse:   QueueListIndices;
      ServerToUse:  ServerListIndices;

    BEGIN
      QueueToUse := NextEvent .inQueue;

      QueueEntry .StartTime   := StartTime;
      QueueEntry .ServiceTime := NextEvent .ServiceTime;

      IF  FoundIdleServer ( NextEvent .inQueue, ServerToUse )  THEN
                                            (* process customer immediately *)
        ServerList [ QueueToUse, ServerToUse ] .myCustomer := QueueEntry;
        ActivateServer ( QueueToUse, ServerToUse, NextEvent .ServiceTime );
        ChangeServerDisplay ( QueueToUse, ServerToUse, Mark );

      ELSE                                  (* add it to the queue *)
        WITH  QueueList [ QueueToUse ]  DO
          FIFOEnqueue ( QueueEntry, theQueue );
          INC ( CurrentSize );

          ChangeQueueDisplay ( QueueToUse, CurrentSize,  Mark );
        END;   (* WITH QueueList[QueueToUse] *)
      END;   (* IF *)
    END  AssignCustomer;

(*                                                                       [16]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(*  Set the server specified by the parameter to idle.
*)

  PROCEDURE  IdleServer (
                 (*in*)  inQueue:  QueueListIndices;
                 (*in*)  Server:   ServerListIndices );

    VAR
      event: Events;

    BEGIN
      WITH  ServerList [ inQueue, Server ]  DO
        IdleNow   := TRUE;
        IdleSince := CurrentTime;

        IF  QueueList [ inQueue ] .SinkOutputTo # 0  THEN
          event .Time        := CurrentTime;
          event .inQueue     := QueueList [ inQueue ] .SinkOutputTo;
          event .Type        := CustomerArrives;
          event .ServiceTime := ServiceTimeFor (
                                        QueueList [ inQueue ] .SinkOutputTo );
          event .Sentinel    := SentinelValue;

          AssignCustomer ( event,
                      ServerList [ inQueue, Server ] .myCustomer .StartTime );
        END;   (*IF*)
      END;   (*WITH*)
    END  IdleServer;

(*                                                                       [17]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* Assign the front customer in the queue specified by the first parameter
   to the server which has been idle the longest.  Log the waiting time for
   this customer.  Place an entry in the event queue for the time the server
   will finish.
*)

  PROCEDURE  ServeWaitingCustomer (
                           (*in*)  inQueue: QueueListIndices );

    VAR
      ServerToUse:  ServerListIndices;
      QueueEntry:   QueueEntryData;
      DataIsValid:  BOOLEAN;

    BEGIN

      IF  FoundIdleServer ( inQueue, ServerToUse )  THEN
        Dequeue ( QueueEntry, QueueList [ inQueue ] .theQueue, DataIsValid );

        IF  DataIsValid  THEN
          WITH  QueueList [ inQueue ]  DO
            ChangeQueueDisplay ( inQueue, CurrentSize, Unmark );
            DEC ( CurrentSize );

            ActivateServer ( inQueue, ServerToUse, QueueEntry .ServiceTime );
            ChangeServerDisplay ( inQueue, ServerToUse, Mark );

            TotalWait := TotalWait  +
                               LONGCARD ( CurrentTime - QueueEntry .StartTime );
          END;   (* WITH QueueList[inQueue] *)

        ELSE
          DisplayMessage ( ErrorMessage, "dequeue failed in ServeCustomer" );
        END;

      ELSE
        DisplayMessage ( ErrorMessage, "ServeCustomer called, no idle server" );
      END;
    END  ServeWaitingCustomer;

(*                                                                       [18]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(* The operator has signalled that s/he wants the program stopped, and a
   screen dump of the current event (priority) queue displayed.  The dump is
   displayed one screen's worth at a time.  This procedure would normally be
   invoked only if something has gone awry with the simulation.
*)

PROCEDURE  DumpEventQueueAndAbort ( );

  VAR
    element:  CARDINAL;

  BEGIN
    GotoXY ( 0, 0 );  Clear;  element := 0;

    LOOP
      ReadElement ( NextEvent, EventQueue, element, DataIsValid );

      IF  NOT DataIsValid  THEN
        EXIT;                     (* probably indicates end of queue *)
      END;

      WITH  NextEvent  DO
        WrCard ( Time, 6 );  WrCard ( inQueue, 4 );

        CASE  Type  OF
          CustomerArrives:
            WrStr ( ' customer arrival: ' );
            WrCard ( ServiceTime, 1 );
        |
          ServerFinishes:
            WrStr ( ' server finishes:  ' );
            WrCard ( Server, 1 );
        END;  (* CASE Type *)
      END;  (* WITH NextEvent *)

      WrLn;
      INC ( element );

      IF  ( element MOD 20 ) = 0  THEN
        Delay ( 20000 );
      END;
    END;  (* LOOP *)

    HALT;
  END  DumpEventQueueAndAbort;

(*                                                                       [19]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


  BEGIN  (* RunTheSimulation *)
    SetInitialState;

    WHILE  CurrentTime <= SimulationPeriod  DO
      IF  KeyPressed ( )  AND  ( RdKey ( ) = 'X' )  THEN
        DumpEventQueueAndAbort;
      END;

      Dequeue ( NextEvent, EventQueue, DataIsValid );

      IF  NextEvent .Sentinel # SentinelValue  THEN
        DisplayMessage ( ErrorMessage, "invalid sentinel: " );
        WrCard ( NextEvent .Sentinel, 1 );
        WrStr  ( " at time " );  WrCard ( CurrentTime, 1 );
        WrCard ( NextEvent .inQueue, 3 );
        WrCard ( ORD ( DataIsValid ), 2 );
      END;   (* IF invalid sentinel *)

      IF  DataIsValid  THEN
        NextQueue   := NextEvent .inQueue;
        CurrentTime := NextEvent .Time;
        DisplayCurrentTime ( NextEvent .Time );

        CASE  NextEvent .Type  OF
          CustomerArrives:
            AssignCustomer ( NextEvent, CurrentTime );

            IF  QueueList [ NextEvent .inQueue ] .ExternalInput  THEN
              WITH  NextEvent  DO
                (* note that NextEvent .inQueue and NextEvent .Type are
                   already set correctly from the entry dequeued above *)
                Time        := CurrentTime + ExternalArrivalInterval ( );
                ServiceTime := ServiceTimeFor ( inQueue );
                Sentinel    := SentinelValue;

                PriorityEnqueue ( NextEvent, EventQueue );
              END;   (* WITH *)
            END;   (* IF not an internal customer *)
        |
          ServerFinishes:
            IdleServer ( NextQueue, NextEvent .Server );
            ChangeServerDisplay ( NextQueue, NextEvent .Server, Unmark );

            IF  NOT isEmpty ( QueueList [ NextQueue ] .theQueue )  THEN
              ServeWaitingCustomer ( NextQueue );
            END;
        END;    (* CASE NextEventType *)

      ELSE
        DisplayMessage ( ErrorMessage, "event dequeue failed" );
      END;    (* IF DataIsValid *)
    END;    (* WHILE within simulation period *)

    DestroyQueue ( EventQueue );
  END  RunTheSimulation;

(*                                                                       [20]
 source: h:\modula\code\queues\QueuExam.MOD  v1.0a        revised: 88.07.22 *)


(*  Clean up storage allocations for queues.
*)

PROCEDURE  CleanUp ( );

  VAR
    QueueIndex: QueueListIndices;

  BEGIN
    FOR  QueueIndex := 1  TO  NumberOfQueues  DO
      DestroyQueue ( QueueList [ QueueIndex ] .theQueue );
    END;
  END  CleanUp;



BEGIN
  GetProcessParameters ( IsIndependentRun,
                         SimulationPeriod,  ArrivalIntervalEV );

  SpecifyQueues     ( NumberOfQueues );
  InitializeServers ( NumberOfQueues );
  RedirectInput     ( "CON" );         (* allow further input from keyboard *)
  TestParameters    ( );

  IF  OperatorApproves ( )  THEN
    RunTheSimulation ( );
    DisplaySummary ( QueueList, ServerList, NumberOfQueues );
  END;

  CleanUp ( );
END  QueuExample.