From:	SCOVCB::GALVIN_FX    31-JAN-1989 09:01
To:	ARISIA::EVERHART
Subj:	

package body RESOURCES is

   use UTILITY.REAL_IO; use UTILITY.INT_IO;

   package body STORAGES is

      --======================
      -- STORAGES DECLARATIONS
      --======================

      TRC_OPTION : UTILITY.OPTION := UTILITY.OFF;
      RPT_OPTION : UTILITY.OPTION := UTILITY.ON;
      DMP_OPTION : UTILITY.OPTION := UTILITY.OFF;

      type WAIT_REC is record
         JOB      : SIMULATION.PROCESS;
         PRIORITY : float;
         TIME     : float;
         AMOUNT   : natural;
         NAME     : UTILITY.CHAR_STRING;
      end record;
      type WAIT_PTR is access WAIT_REC;
      procedure FREE_WAIT is new UNCHECKED_DEALLOCATION (WAIT_REC, WAIT_PTR);

      --====================
      -- STORAGES OPERATIONS
      --====================

      function WAIT_COMP (X,Y : WAIT_PTR) return boolean is
      begin
         if X.PRIORITY < Y.PRIORITY then
            return TRUE;
         elsif X.PRIORITY = Y.PRIORITY and X.TIME < Y.TIME then
            return TRUE;
         else
            return FALSE;
         end if;
      end WAIT_COMP;

      function ALLOC_COMP (X,Y : STORAGE_UNIT) return boolean is
      begin
         return TRUE;
      end ALLOC_COMP;

      function STOR_COMP (X,Y : STORAGE) return boolean is
      begin
         return TRUE;
      end STOR_COMP;

      package A is new QUEUES ("STORALOC", STORAGE_UNIT, ALLOC_COMP);
      package W is new QUEUES ("STORWAIT", WAIT_PTR, WAIT_COMP);
      package S is new QUEUES ("STORAGEQ", STORAGE, STOR_COMP);

      package SUB is
         STOR_Q : S.QUEUE;
      end SUB;
      use SUB;

      procedure FREE_STORAGE is new UNCHECKED_DEALLOCATION 
         (STORAGE_RESOURCE, STORAGE);

      task body STORAGE_RESOURCE is
   -- DECLARE STORAGE LISTS
         ALLOC : A.QUEUE;
         WAIT : W.QUEUE;
         NO_OF_SERVERS, CAPACITY, NO_OF_REQUESTS, TOTAL,
         ENTRIES, MAX_LENGTH : integer := 0;
         TOTAL_BUSY_TIME, MEAN_NO_USED, PRI, AMT, TIME_LAST, SUM_TIME_X_LENGTH,
         SUM_OF_WAIT, SUM_OF_WAIT2, CAP, DTIME, CREATE_TIME : float := 0.0;
         Q_JOB : SIMULATION.PROCESS;
         RES_NAME : UTILITY.CHAR_STRING;
         RES_REF : STORAGE := null;
         ENABLE_FLAG : boolean := TRUE;
         WAIT_PROCESS : WAIT_PTR := null;
         UNIT : STORAGE_UNIT := null;
         PTR : STORAGE_UNIT := null;
      begin
         accept SETUP (SERVER_LIMIT : in integer;
                       AMT_OF_RES : in integer;
                       STORAGE_NAME : in STRING;
                       RES_REFER : in STORAGE) do
            NO_OF_SERVERS := SERVER_LIMIT;
            CAPACITY := AMT_OF_RES;
            CAP := float (AMT_OF_RES);
            CREATE_TIME := SIMULATION.CURRENT_SIMULATION_TIME;
            RES_NAME := UTILITY.STRING_MATCH (STORAGE_NAME, 8);
            RES_REF := RES_REFER;
            A.CREATE_QUEUE (ALLOC, RES_NAME);
            W.CREATE_QUEUE (WAIT, RES_NAME);
         end SETUP;

         loop
            select
               accept RES_REQUEST (UNIT_ALLOCATED : in out STORAGE_UNIT; 
                                   AMOUNT_REQUESTED : in integer;
                                   ALLOC_RESPONSE : in out ALLOC_TYPE ) do
                  if ALLOC_RESPONSE = FIRST_REQUEST then
                     NO_OF_REQUESTS := NO_OF_REQUESTS + 1;
                  end if;
                  if NO_OF_SERVERS = 0 or AMOUNT_REQUESTED > CAPACITY then
    --  put in waiting pile, prioritize by priority and time of entry (FIFO)
                     WAIT_PROCESS := new WAIT_REC;
                     WAIT_PROCESS.JOB := SIMULATION.CURRENT_PROCESS;
                     WAIT_PROCESS.NAME := SIMULATION.CURRENT_PROCESS_NAME;
                     WAIT_PROCESS.PRIORITY := SIMULATION.CURRENT_PROCESS_PRIORITY;
                     WAIT_PROCESS.TIME := SIMULATION.CURRENT_SIMULATION_TIME;
                     WAIT_PROCESS.AMOUNT := AMOUNT_REQUESTED;
                     SUM_TIME_X_LENGTH := SUM_TIME_X_LENGTH +
                          FLOAT(W.LENGTH_OF_QUEUE(WAIT)) * 
                          (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                     TIME_LAST := SIMULATION.CURRENT_SIMULATION_TIME;
                     W.INSERT_QUEUE (WAIT, WAIT_PROCESS);
                     ALLOC_RESPONSE := WAITING;
                     ENTRIES := ENTRIES + 1;
                     if W.LENGTH_OF_QUEUE(WAIT) > MAX_LENGTH then
                           MAX_LENGTH := W.LENGTH_OF_QUEUE (WAIT);
                     end if;
                     if TRC_OPTION = UTILITY.ON then
                         UTILITY.OUTPUT_TRACE 
                           (SIMULATION.CURRENT_SIMULATION_TIME,
                           SIMULATION.CURRENT_PROCESS_NAME,
                           "WAITING for STORAGE " & RES_NAME, UTILITY.LF);
                     end if;
                  else
                     ALLOC_RESPONSE := ALLOCATED;
                     NO_OF_SERVERS := NO_OF_SERVERS - 1;
                     CAPACITY := CAPACITY - AMOUNT_REQUESTED;
                     UNIT_ALLOCATED := new STORAGE_ALLOCATION_LIST;
    -- put in allocation pile
                     A.INSERT_QUEUE (ALLOC, UNIT_ALLOCATED);
                     UNIT_ALLOCATED.JOB_NAME := SIMULATION.CURRENT_PROCESS_NAME;
                     UNIT_ALLOCATED.BUSY_START_TIME := SIMULATION.CURRENT_SIMULATION_TIME;
                     UNIT_ALLOCATED.AMOUNT := AMOUNT_REQUESTED;
                     UNIT_ALLOCATED.RES_UNIT := RES_REF;
                     if TRC_OPTION = UTILITY.ON then
                        UTILITY.OUTPUT_TRACE 
                           (SIMULATION.CURRENT_SIMULATION_TIME,
                           SIMULATION.CURRENT_PROCESS_NAME,
                           "ALLOCATED STORAGE " & RES_NAME, UTILITY.LF);
                     end if;
                  end if;
               end RES_REQUEST;
            or
               accept RES_RELEASE (UNIT_ALLOCATED : in out STORAGE_UNIT) do 
                  NO_OF_SERVERS := NO_OF_SERVERS + 1;
                  DTIME := SIMULATION.CURRENT_SIMULATION_TIME - 
                     UNIT_ALLOCATED.BUSY_START_TIME;
                  TOTAL_BUSY_TIME := TOTAL_BUSY_TIME + DTIME;
                  MEAN_NO_USED := MEAN_NO_USED + DTIME *
                                  float (UNIT_ALLOCATED.AMOUNT);
                  CAPACITY := CAPACITY + UNIT_ALLOCATED.AMOUNT;
     --  LOOK FOR UNIT_ALLOCATED IN ALLOCATION PILE
                  A.FIRST_IN_QUEUE (ALLOC, PTR);
                  while PTR /= UNIT_ALLOCATED loop
                     A.NEXT_IN_QUEUE (ALLOC, PTR);
                  end loop;
     --  DEQUEUE
                  A.REMOVE_QUEUE_CURRENT (ALLOC);
                  UNIT_ALLOCATED := null;
                  if TRC_OPTION = UTILITY.ON then
                     UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                                SIMULATION.CURRENT_PROCESS_NAME,
                                "RELEASED STORAGE  " & RES_NAME, UTILITY.LF);
                  end if;
                  TOTAL := 0;
      -- STEP THROUGH WAITING LIST
                  if not W.QUEUE_IS_EMPTY (WAIT) then
                     W.FIRST_IN_QUEUE (WAIT, WAIT_PROCESS);
                     for I in 1 .. W.LENGTH_OF_QUEUE (WAIT) loop
                        if TOTAL + WAIT_PROCESS.AMOUNT <= CAPACITY then
                           SIMULATION.UNBLOCK (WAIT_PROCESS.JOB);
                           TOTAL := TOTAL + WAIT_PROCESS.AMOUNT;
                           DTIME := SIMULATION.CURRENT_SIMULATION_TIME - 
                                    WAIT_PROCESS.TIME;
                           SUM_OF_WAIT := SUM_OF_WAIT + DTIME;
                           SUM_OF_WAIT2 := SUM_OF_WAIT2 + DTIME * DTIME;
                           SUM_TIME_X_LENGTH := SUM_TIME_X_LENGTH +
                              float (W.LENGTH_OF_QUEUE (WAIT)) * 
                             (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                           TIME_LAST := SIMULATION.CURRENT_SIMULATION_TIME;
       -- DEQUEUE
                           W.REMOVE_QUEUE_CURRENT (WAIT);
                           FREE_WAIT (WAIT_PROCESS);
                        end if;
                        if not W.QUEUE_IS_EMPTY (WAIT) then
                           W.NEXT_IN_QUEUE (WAIT, WAIT_PROCESS);
                        end if;
                     end loop;
                  end if;
               end RES_RELEASE;
            or
               accept ENABLED (FLAG : out boolean) do
                  FLAG := ENABLE_FLAG;
               end ENABLED;
            or
               accept SERVERS (NUMBER_OF_AVAILABLE_SERVERS : out integer) do
                  NUMBER_OF_AVAILABLE_SERVERS := NO_OF_SERVERS;
               end SERVERS;
            or
               accept CAP_AVAIL (AMOUNT_AVAILABLE : out integer) do
                  AMOUNT_AVAILABLE := CAPACITY;
               end CAP_AVAIL;
            or
               accept ALTER (FLAG : in boolean;
                             SERVER_LIMIT, AMT_RES : in integer) do
                  ENABLE_FLAG := FLAG;
                  NO_OF_SERVERS := SERVER_LIMIT;
                  CAPACITY := AMT_RES;
                  if TRC_OPTION = UTILITY.ON then
                     UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                                     SIMULATION.CURRENT_PROCESS_NAME,
                        "storage resource " & RES_NAME & " modified",
                        UTILITY.NO_LF);
                     if ENABLE_FLAG = TRUE then
                        put (" ENABLED");
                     else
                        put (" DISABLED");
                     end if;
                     put (" with capacity ");
                     put (CAPACITY);
                     put (" and ");
                     put (NO_OF_SERVERS,4);
                     put (" servers");
                     new_line;
                  end if;
               end ALTER;
            or
               accept REPORT do
                  declare 
                     TOT_TIME, MEAN, SUM_WAIT, SUM_WAIT2, SUM_TIME 
                     : float := 0.0;
                     ZERO : constant float := 0.0;
                  begin
                     put (RES_NAME); put (" ");                 -- RESOURCE
                     put (integer (CAP), 6); put (" ");         -- CAPACITY
                     put (NO_OF_REQUESTS, 6); put (" ");        -- REQUESTS
                     TOT_TIME := TOTAL_BUSY_TIME;
                     MEAN := MEAN_NO_USED;
        -- step through allocation pile
                     if not A.QUEUE_IS_EMPTY (ALLOC) then
                        A.FIRST_IN_QUEUE (ALLOC, UNIT);
                        for I in 1 .. A.LENGTH_OF_QUEUE (ALLOC) loop
                           DTIME := SIMULATION.CURRENT_SIMULATION_TIME -
                                    UNIT.BUSY_START_TIME;
                           TOT_TIME := TOT_TIME + DTIME;
                           MEAN := MEAN + DTIME * float (UNIT.AMOUNT);
                           A.NEXT_IN_QUEUE (ALLOC, UNIT);
                        end loop;
                     end if;
                     if NO_OF_REQUESTS = 0 then
                        put (ZERO, 2, 2, 3);
                     else                                     -- MEAN BUSY TIME
                        put (TOT_TIME / float (NO_OF_REQUESTS), 2, 2, 3); 
                     end if;
                     put (" ");
                     if SIMULATION.CURRENT_SIMULATION_TIME - CREATE_TIME 
                        = 0.0 then
                        put (ZERO, 2, 2, 3);
                     else
                        put (100.0 * MEAN / 
                           ((SIMULATION.CURRENT_SIMULATION_TIME - CREATE_TIME) 
                           * CAP), 2, 2, 3);             -- PERCENT UTILIZATION
                     end if;
                     if TIME_LAST > 0.0 then
                        SUM_WAIT := SUM_OF_WAIT + DTIME;
                        SUM_WAIT2 := SUM_OF_WAIT2 + DTIME * DTIME;
                        SUM_TIME := SUM_TIME_X_LENGTH + 
                           float (W.LENGTH_OF_QUEUE (WAIT)) * 
                           (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                        put (" ");                         -- MEAN WAITING TIME
                        put (SUM_WAIT /  float (ENTRIES), 2, 2, 3); 
                        put (" ");
                        if ENTRIES = 1 or else 
                           SUM_WAIT2 <= SUM_WAIT * SUM_WAIT / float (ENTRIES) 
                           then 
                           put (ZERO, 2, 2, 3);
                        else                          -- STD. DEV. WAITING TIME
                           put (MATH.SQRT ((SUM_WAIT2 -  SUM_WAIT * SUM_WAIT / 
                           float (ENTRIES)) / float (ENTRIES - 1)), 2, 2, 3); 
                        end if;
                        put (" ");
                        if SIMULATION.CURRENT_SIMULATION_TIME = 0.0 then
                           put (ZERO, 2, 2, 3);
                        else                               -- QUEUE MEAN
                           put (SUM_TIME / SIMULATION.CURRENT_SIMULATION_TIME, 
                           2, 2, 3);
                        end if;
                        put (" ");
                        put (MAX_LENGTH, 7);               -- QUEUE LENGTH MAX
                        put (" ");
                        put (ENTRIES, 7);                  -- NUMBER OF ENTRIES
                     end if;
                     new_line;
                  end;                   -- this "end" closes REPORT's "begin"
               end REPORT;
            or
               accept DUMP do
                  new_line; 
                  put_line ("  STORAGE RESOURCE  " & RES_NAME & "  DUMP"); 
                  new_line; 
                  put_line ("                 ALLOCATED");
                  put_line ("  AMOUNT       TIME         PROCESS");
        -- STEP THROUGH ALLOCATION PILE
                  if not A.QUEUE_IS_EMPTY (ALLOC) then
                     A.FIRST_IN_QUEUE (ALLOC, UNIT);
                     for I in 1 .. A.LENGTH_OF_QUEUE (ALLOC) loop
                        put (UNIT.AMOUNT);
                        put ("  ");
                        put (UNIT.BUSY_START_TIME);
                        put_line ("  " & UNIT.JOB_NAME);
                        A.NEXT_IN_QUEUE (ALLOC, UNIT);
                     end loop;
                  else
                     put_line ("    NONE");
                  end if;
                  new_line; put_line ("                     WAITING");
        -- STEP THROUGH WAITING PILE
                  if not W.QUEUE_IS_EMPTY (WAIT) then
                     W.FIRST_IN_QUEUE (WAIT, WAIT_PROCESS);
                     for I in 1 .. W.LENGTH_OF_QUEUE (WAIT) loop
                        put (WAIT_PROCESS.AMOUNT);
                        put ("  ");
                        put (WAIT_PROCESS.TIME);
                        put_line ("  " & WAIT_PROCESS.NAME);
                        W.NEXT_IN_QUEUE (WAIT, WAIT_PROCESS);
                     end loop;
                  else
                     put_line ("     NONE");
                  end if;
               end DUMP;
            or
               terminate;
            end select;
         end loop;
      exception
         when others =>
            SIMULATION.SIMULATOR_ERROR ("STORAGE RESOURCE " & RES_NAME & 
               " EXCEPTION", UTILITY.FATAL);
      end STORAGE_RESOURCE;


      procedure CREATE_STORAGE (STORAGE_REF : in out STORAGE;
                                STORAGE_NAME : in STRING;
                                CAPACITY : in integer; 
                                NO_OF_SERVERS : in integer) is
      begin
         STORAGE_REF := new STORAGE_RESOURCE;
--  PUT IN STORAGE PILE
         S.INSERT_QUEUE (STOR_Q, STORAGE_REF);
         STORAGE_REF.SETUP (NO_OF_SERVERS, CAPACITY, 
                            STORAGE_NAME, STORAGE_REF);
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                            SIMULATION.CURRENT_PROCESS_NAME,
                            "storage resource ", UTILITY.NO_LF);
            put (STORAGE_NAME);
            put (" created with capacity ");
            put (CAPACITY);
            put (" and can serve ");
            put (NO_OF_SERVERS, 4);
            new_line;
         end if;
      end CREATE_STORAGE;

      procedure REQUEST_STORAGE (STORAGE_REF : in out STORAGE;
                                 AMOUNT_REQUESTED : in integer;
                                 UNIT_ALLOCATED : in out STORAGE_UNIT) is
         RESPONSE : ALLOC_TYPE := FIRST_REQUEST;
      begin
         if not STORAGE_ENABLED (STORAGE_REF) then
            raise STORAGE_IS_DISABLED;
         end if;
         while RESPONSE /= ALLOCATED loop
            STORAGE_REF.RES_REQUEST (UNIT_ALLOCATED, AMOUNT_REQUESTED, 
                                     RESPONSE);
            exit when RESPONSE = ALLOCATED;
            SIMULATION.BLOCK;
         end loop;
      end REQUEST_STORAGE;

      procedure RELEASE_STORAGE (UNIT_ALLOCATED : in out STORAGE_UNIT) is
      begin
         if UNIT_ALLOCATED = null then
            raise STORAGE_UNIT_NOT_ALLOCATED;
         end if;
         if not STORAGE_ENABLED (UNIT_ALLOCATED.RES_UNIT) then
            raise STORAGE_IS_DISABLED;
         end if;
         UNIT_ALLOCATED.RES_UNIT.RES_RELEASE (UNIT_ALLOCATED);
      end RELEASE_STORAGE;

      procedure DESTROY_STORAGE (STORAGE_REF : in out STORAGE) is
         RES : STORAGE;
      begin
         if STORAGE_REF = null then
            raise STORAGE_DOES_NOT_EXIST;
         end if;
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
               SIMULATION.CURRENT_PROCESS_NAME,
               "destroy storage resource ", UTILITY.LF);
-- entry needed in task storage_resource to get res_name
         end if;
-- step through storage pile to find and dequeue this storage 
         S.FIRST_IN_QUEUE (STOR_Q, RES);
         for I in 1 .. S.LENGTH_OF_QUEUE (STOR_Q) loop
            if RES = STORAGE_REF then
               S.REMOVE_QUEUE_CURRENT (STOR_Q);
               exit;
            end if;
            S.NEXT_IN_QUEUE (STOR_Q, RES);
         end loop;
         FREE_STORAGE (STORAGE_REF);
      end DESTROY_STORAGE;

      procedure MODIFY_STORAGE (STORAGE_REF  : in out STORAGE;
                                ENABLE_FLAG  : in boolean;
                                CAPACITY     : in integer;
                                SERVER_LIMIT : in integer) is
      begin
         if STORAGE_REF = null then
            raise STORAGE_DOES_NOT_EXIST;
         end if;
         STORAGE_REF.ALTER (ENABLE_FLAG, SERVER_LIMIT, CAPACITY);
      end MODIFY_STORAGE;

      function STORAGE_ENABLED (STORAGE_REF : in STORAGE) return boolean is
         FLAG : boolean;
      begin
         if STORAGE_REF = null then
            raise STORAGE_DOES_NOT_EXIST;
         end if;
         STORAGE_REF.ENABLED (FLAG);
         return FLAG;
      end STORAGE_ENABLED;

      function STORAGE_SERVERS (STORAGE_REF : in STORAGE) return integer is
         VAL : integer;
      begin
         if STORAGE_REF = null then
            raise STORAGE_DOES_NOT_EXIST;
         end if;
         STORAGE_REF.SERVERS (VAL);
         return VAL;
      end STORAGE_SERVERS;

      function STORAGE_CAPACITY (STORAGE_REF : in STORAGE) return integer is
         VAL : integer;
      begin
         if STORAGE_REF = null then
            raise STORAGE_DOES_NOT_EXIST;
         end if;
         STORAGE_REF.CAP_AVAIL (VAL);
         return VAL;
      end STORAGE_CAPACITY;

      procedure SET_STORAGE_REPORT_OPTION 
                (REPORT_OPTION : in UTILITY.OPTION) is
      begin
         RPT_OPTION := REPORT_OPTION;
      end SET_STORAGE_REPORT_OPTION;
  
      procedure SET_STORAGE_TRACE_OPTION (TRACE_OPTION : in UTILITY.OPTION) is
      begin
         TRC_OPTION := TRACE_OPTION;
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "SET STORAGE TRACE OPTION ON", UTILITY.LF);
         end if;
         A.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
         W.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
         S.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
      end SET_STORAGE_TRACE_OPTION;

      procedure SET_STORAGE_DUMP_OPTION (DUMP_OPTION : in UTILITY.OPTION) is
      begin
         DMP_OPTION := DUMP_OPTION;
      end SET_STORAGE_DUMP_OPTION;

      procedure OUTPUT_STORAGE_REPORT is
         RES : STORAGE;
      begin
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "OUTPUT STORAGE REPORT", UTILITY.LF);
         end if;

    -- IF THERE ARE SOME RESOURCES IN THE STORAGE PILE
         if not S.QUEUE_IS_EMPTY (STOR_Q) and RPT_OPTION = UTILITY.ON then
            UTILITY.CONTROL_OUTPUT;
            new_line;
            put ("STORAGE RESOURCE REPORT           simulation time = ");
            put (SIMULATION.CURRENT_SIMULATION_TIME); new_line;
            put_line ("                NUM OF MEAN BUSY  PERCENT  " &
            "MEAN WAIT   QUEUE    QUEUE   NUM OF");
            put_line ("RESOURCE CAPAC. REQUE.    TIME   UTILIZAT. " &
            "   TIME   LEN. MEAN LEN MAX ENTRIES");
    --  STEP THROUGH STORAGE PILE
            S.FIRST_IN_QUEUE (STOR_Q, RES);
            for I in 1 .. S.LENGTH_OF_QUEUE (STOR_Q) loop
               RES.REPORT;
               S.NEXT_IN_QUEUE (STOR_Q, RES);
            end loop;
            new_line;
            UTILITY.RELEASE_OUTPUT_CONTROL;
         end if;
      end OUTPUT_STORAGE_REPORT;

-- --------------------------------------------------------------------
      procedure OUTPUT_STORAGE_DUMP is
         RES : STORAGE;
      begin
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "OUTPUT STORAGE DUMP", UTILITY.LF);
         end if;

    -- IF THERE ARE SOME RESOURCES IN THE STORAGE PILE
         if not S.QUEUE_IS_EMPTY (STOR_Q) and DMP_OPTION = UTILITY.ON then
            UTILITY.CONTROL_OUTPUT;
            new_line;
    --  STEP THROUGH STORAGE PILE
            S.FIRST_IN_QUEUE (STOR_Q, RES);
            for I in 1 .. S.LENGTH_OF_QUEUE (STOR_Q) loop
               RES.DUMP;
               S.NEXT_IN_QUEUE (STOR_Q, RES);
            end loop;
            new_line;
            UTILITY.RELEASE_OUTPUT_CONTROL;
         end if;
      end OUTPUT_STORAGE_DUMP;


   begin
      S.CREATE_QUEUE (STOR_Q, "STOR_Q");
   end STORAGES;

--===========================================================================

   package body FACILITIES is

      --========================
      -- FACILITIES DECLARATIONS
      --========================

      TRC_OPTION : UTILITY.OPTION := UTILITY.OFF;
      RPT_OPTION : UTILITY.OPTION := UTILITY.ON;
      DMP_OPTION : UTILITY.OPTION := UTILITY.OFF;

      type WAIT_REC is record
         JOB      : SIMULATION.PROCESS;
         PRIORITY : float;
         TIME     : float;
         NAME     : UTILITY.CHAR_STRING;
      end record;
      type WAIT_PTR is access WAIT_REC;
      procedure FREE_WAIT is new UNCHECKED_DEALLOCATION (WAIT_REC, WAIT_PTR);


      --======================
      -- FACILITIES OPERATIONS
      --======================

      function WAIT_COMP (X,Y : WAIT_PTR) return boolean is
      begin
         if X.PRIORITY < Y.PRIORITY then
            return TRUE;
         elsif X.PRIORITY = Y.PRIORITY and X.TIME < Y.TIME then
            return TRUE;
         else
            return FALSE;
         end if;
      end WAIT_COMP;

      function FAC_COMP (X,Y : FACILITY) return boolean is
      begin
         return TRUE;
      end FAC_COMP;

      package W is new QUEUES ("FAC_WAIT", WAIT_PTR, WAIT_COMP);
      package F is new QUEUES ("FACILTYQ", FACILITY, FAC_COMP);

      package SUB is
         FAC_Q : F.QUEUE;
      end SUB;
      use SUB;

      procedure FREE_FACILITY is new UNCHECKED_DEALLOCATION 
         (FACILITY_RESOURCE, FACILITY);

      task body FACILITY_RESOURCE is
   -- DECLARE FACILITY LISTS
         WAIT : W.QUEUE;
         ALLOC_FLAG : boolean := false;
         NO_OF_REQUESTS, ENTRIES, MAX_LENGTH : integer := 0;
         TOTAL_BUSY_TIME, PRI, TIME_LAST, SUM_TIME_X_LENGTH,
         SUM_OF_WAIT, SUM_OF_WAIT2, DTIME, CREATE_TIME : float := 0.0;
         RES_NAME : UTILITY.CHAR_STRING;
         ENABLE_FLAG : boolean := TRUE;
         WAIT_PROCESS : WAIT_PTR := null;
         BUSY_START_TIME : float := 0.0;
         ALLOC_JOB_NAME : UTILITY.CHAR_STRING;
         ALLOC_JOB : SIMULATION.PROCESS;
      begin
         accept SETUP (FACILITY_NAME : in string) do
            CREATE_TIME := SIMULATION.CURRENT_SIMULATION_TIME;
            RES_NAME := UTILITY.STRING_MATCH (FACILITY_NAME, 8);
            W.CREATE_QUEUE (WAIT, RES_NAME);
         end SETUP;

         loop
            select
               accept RES_REQUEST (ALLOC_RESPONSE : in out ALLOC_TYPE ) do
                  if ALLOC_RESPONSE = FIRST_REQUEST then
                     NO_OF_REQUESTS := NO_OF_REQUESTS + 1;
                  end if;
                  if ALLOC_FLAG = true then
    --  put in waiting pile, prioritize by priority and time of entry (FIFO)
                     WAIT_PROCESS := new WAIT_REC;
                     WAIT_PROCESS.JOB := SIMULATION.CURRENT_PROCESS;
                     WAIT_PROCESS.NAME := SIMULATION.CURRENT_PROCESS_NAME;
                     WAIT_PROCESS.PRIORITY := SIMULATION.CURRENT_PROCESS_PRIORITY;
                     WAIT_PROCESS.TIME := SIMULATION.CURRENT_SIMULATION_TIME;
                     SUM_TIME_X_LENGTH := SUM_TIME_X_LENGTH +
                          float (W.LENGTH_OF_QUEUE(WAIT)) * 
                          (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                     TIME_LAST := SIMULATION.CURRENT_SIMULATION_TIME;
                     W.INSERT_QUEUE (WAIT, WAIT_PROCESS);
                     ALLOC_RESPONSE := WAITING;
                     ENTRIES := ENTRIES + 1;
                     if W.LENGTH_OF_QUEUE (WAIT) > MAX_LENGTH then
                           MAX_LENGTH := W.LENGTH_OF_QUEUE (WAIT);
                     end if;
                     if TRC_OPTION = UTILITY.ON then
                         UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                                         SIMULATION.CURRENT_PROCESS_NAME,
                                         "WAITING for FACILITY " & RES_NAME, 
                                         UTILITY.LF);
                     end if;
                  else
                     ALLOC_RESPONSE := ALLOCATED;
                     ALLOC_FLAG := true;
                     ALLOC_JOB := SIMULATION.CURRENT_PROCESS;
                     ALLOC_JOB_NAME := SIMULATION.CURRENT_PROCESS_NAME;
                     BUSY_START_TIME := SIMULATION.CURRENT_SIMULATION_TIME;
                     if TRC_OPTION = UTILITY.ON then
                        UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                                        SIMULATION.CURRENT_PROCESS_NAME,
                                        "ALLOCATED FACILITY " & RES_NAME, 
                                        UTILITY.LF);
                     end if;
                  end if;
               end RES_REQUEST;
            or
               accept RES_RELEASE do 
     --  check if facility was allocated by this process
                  if ALLOC_JOB /= SIMULATION.CURRENT_PROCESS then
                     raise FACILITY_NOT_ALLOCATED;
                  end if;
     --  check if facility was allocated
                  if ALLOC_FLAG /= true then
                     raise FACILITY_NOT_ALLOCATED;
                  end if;
     -- take time statistics
                  DTIME := SIMULATION.CURRENT_SIMULATION_TIME - BUSY_START_TIME;
                  TOTAL_BUSY_TIME := TOTAL_BUSY_TIME + DTIME;
     --  free this facility
                  ALLOC_FLAG := false;
                  if TRC_OPTION = UTILITY.ON then
                     UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                                SIMULATION.CURRENT_PROCESS_NAME,
                                "RELEASED FACILITY  " & RES_NAME, UTILITY.LF);
                  end if;
      -- remove one process from the waiting list
                  if not W.QUEUE_IS_EMPTY (WAIT) then
                     W.REMOVE_QUEUE_FIRST (WAIT, WAIT_PROCESS);
                     SIMULATION.UNBLOCK (WAIT_PROCESS.JOB);
                     DTIME := SIMULATION.CURRENT_SIMULATION_TIME - 
                              WAIT_PROCESS.TIME;
                     SUM_OF_WAIT := SUM_OF_WAIT + DTIME;
                     SUM_OF_WAIT2 := SUM_OF_WAIT2 + DTIME * DTIME;
                     SUM_TIME_X_LENGTH := SUM_TIME_X_LENGTH +
                        float (W.LENGTH_OF_QUEUE (WAIT)) * 
                       (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                     TIME_LAST := SIMULATION.CURRENT_SIMULATION_TIME;
                     FREE_WAIT (WAIT_PROCESS);
                  end if;
               end RES_RELEASE;
            or
               accept ENABLED (FLAG : out boolean) do
                  FLAG := ENABLE_FLAG;
               end ENABLED;
            or
               accept ALLOCATED (FLAG : out boolean) do
                  FLAG := ALLOC_FLAG;
               end ALLOCATED;
            or
               accept ALTER (FLAG : in boolean) do
                  ENABLE_FLAG := FLAG;
                  if TRC_OPTION = UTILITY.ON then
                     UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                                           SIMULATION.CURRENT_PROCESS_NAME,
                        "facility resource " & RES_NAME & " modified ",
                        UTILITY.NO_LF);
                     if ENABLE_FLAG = TRUE then
                        put ("ENABLED");
                     else
                        put ("DISABLED");
                     end if;
                     new_line;
                  end if;
               end ALTER;
            or
               accept REPORT do
                  declare 
                     SUM_WAIT, SUM_WAIT2, SUM_TIME : float := 0.0;
                     ZERO : constant float := 0.0;
                  begin
                     put (RES_NAME); put (" ");                 -- RESOURCE
                     put (NO_OF_REQUESTS, 9); put (" ");        -- REQUESTS
                     if NO_OF_REQUESTS = 0 then
                        put (ZERO, 2, 2, 3);
                     else                                     -- MEAN BUSY TIME
                        put (TOTAL_BUSY_TIME / float(NO_OF_REQUESTS), 2, 2, 3);
                     end if;
                     if TIME_LAST > 0.0 then
                        SUM_WAIT := SUM_OF_WAIT + DTIME;
                        SUM_WAIT2 := SUM_OF_WAIT2 + DTIME * DTIME;
                        SUM_TIME := SUM_TIME_X_LENGTH + 
                           float (W.LENGTH_OF_QUEUE (WAIT)) * 
                           (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                     else
                        SUM_WAIT := SUM_OF_WAIT;
                        SUM_WAIT2 := SUM_OF_WAIT2;
                        SUM_TIME := SUM_TIME_X_LENGTH;
                     end if;
                     if ENTRIES > 0 then
                        put (" ");                    -- MEAN WAITING TIME
                        put (SUM_WAIT /  float (ENTRIES), 2, 2, 3); 
                        put (" ");
                        if ENTRIES = 1 or else 
                           SUM_WAIT2 <= SUM_WAIT * SUM_WAIT / float (ENTRIES) 
                           then 
                           put (ZERO, 2, 2, 3);
                        else                          -- STD. DEV. WAITING TIME
                           put (MATH.SQRT ((SUM_WAIT2 -  SUM_WAIT * SUM_WAIT / 
                           float (ENTRIES)) / float (ENTRIES - 1)), 2, 2, 3);
                        end if;
                        put (" ");
                        if SIMULATION.CURRENT_SIMULATION_TIME = 0.0 then
                           put (ZERO, 2, 2, 3);
                        else                               -- QUEUE MEAN
                           put (SUM_TIME / SIMULATION.CURRENT_SIMULATION_TIME,
                           2, 2, 3);
                        end if;
                        put (" ");
                        put (MAX_LENGTH, 9);               -- QUEUE LENGTH MAX
                        put (" ");
                        put (ENTRIES, 9);                  -- NUMBER OF ENTRIES
                     end if;
                     new_line;
                  end;                   -- this "end" closes REPORT's "begin"
               end REPORT;
            or
               accept DUMP do
                  if not ALLOC_FLAG then
                     put_line (RES_NAME & " is free");
                  else
                     put (RES_NAME & "allocated since ");
                     put (BUSY_START_TIME);
                     put_line (" by process " & ALLOC_JOB_NAME); 
        -- STEP THROUGH WAITING PILE
                     if not W.QUEUE_IS_EMPTY (WAIT) then
                        W.FIRST_IN_QUEUE (WAIT, WAIT_PROCESS);
                        for I in 1 .. W.LENGTH_OF_QUEUE (WAIT) loop
                           put ("     Process " & WAIT_PROCESS.NAME & 
                                " waiting since ");
                           put (WAIT_PROCESS.TIME);
                           new_line;
                           W.NEXT_IN_QUEUE (WAIT, WAIT_PROCESS);
                        end loop;
                     end if;
                  end if;
                  new_line;
               end DUMP;
            or
               terminate;
            end select;
         end loop;
      exception
         when others =>
            SIMULATION.SIMULATOR_ERROR ("FACILITY RESOURCE " & RES_NAME & 
               " EXCEPTION", UTILITY.FATAL);
      end FACILITY_RESOURCE;


      procedure CREATE_FACILITY (FACILITY_REF : in out FACILITY;
                                 FACILITY_NAME : in STRING) is
      begin
         FACILITY_REF := new FACILITY_RESOURCE;
--  PUT IN FACILITY PILE
         F.INSERT_QUEUE (FAC_Q, FACILITY_REF);
         FACILITY_REF.SETUP (FACILITY_NAME);
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
               SIMULATION.CURRENT_PROCESS_NAME,
               "created facility type resource: " & FACILITY_NAME, 
               UTILITY.LF);
         end if;
      end CREATE_FACILITY;

      procedure REQUEST_FACILITY (FACILITY_REF : in out FACILITY) is
         RESPONSE : ALLOC_TYPE := FIRST_REQUEST;
      begin
         if not FACILITY_ENABLED (FACILITY_REF) then
            raise FACILITY_IS_DISABLED;
         end if;
         while RESPONSE /= ALLOCATED loop
            FACILITY_REF.RES_REQUEST (RESPONSE);
            exit when RESPONSE = ALLOCATED;
            SIMULATION.BLOCK;
         end loop;
      end REQUEST_FACILITY;

      procedure RELEASE_FACILITY (FACILITY_REF : in out FACILITY) is
      begin
         if not FACILITY_ENABLED (FACILITY_REF) then
            raise FACILITY_IS_DISABLED;
         end if;
         FACILITY_REF.RES_RELEASE;
      end RELEASE_FACILITY;

      procedure DESTROY_FACILITY (FACILITY_REF : in out FACILITY) is
         RES : FACILITY;
      begin
         if FACILITY_REF = null then
            raise FACILITY_DOES_NOT_EXIST;
         end if;
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                            SIMULATION.CURRENT_PROCESS_NAME,
                            "destroy facility resource ", UTILITY.LF);
-- entry needed in facility_resouce to get res_name
         end if;
-- step through facility pile to find and dequeue this facility
         F.FIRST_IN_QUEUE (FAC_Q, RES);
         for I in 1 .. F.LENGTH_OF_QUEUE (FAC_Q) loop
            if RES = FACILITY_REF then
               F.REMOVE_QUEUE_CURRENT (FAC_Q);
               exit;
            end if;
            F.NEXT_IN_QUEUE (FAC_Q, RES);
         end loop;
         FREE_FACILITY (FACILITY_REF);
      end DESTROY_FACILITY;

      procedure MODIFY_FACILITY (FACILITY_REF : in out FACILITY;
                                 ENABLE_FLAG : in boolean) is
      begin
         if FACILITY_REF = null then
            raise FACILITY_DOES_NOT_EXIST;
         end if;
         FACILITY_REF.ALTER (ENABLE_FLAG);
      end MODIFY_FACILITY;

      function FACILITY_ENABLED (FACILITY_REF : in FACILITY) return boolean is
         FLAG : boolean;
      begin
         if FACILITY_REF = null then
            raise FACILITY_DOES_NOT_EXIST;
         end if;
         FACILITY_REF.ENABLED (FLAG);
         return FLAG;
      end FACILITY_ENABLED;

      function FACILITY_ALLOCATED (FACILITY_REF : in FACILITY) 
                                  return boolean is
         FLAG : boolean;
      begin
         if FACILITY_REF = null then
            raise FACILITY_DOES_NOT_EXIST;
         end if;
         FACILITY_REF.ALLOCATED (FLAG);
         return FLAG;
      end FACILITY_ALLOCATED;

      procedure SET_FACILITY_REPORT_OPTION 
                                (REPORT_OPTION : in UTILITY.OPTION) is
      begin
         RPT_OPTION := REPORT_OPTION;
      end SET_FACILITY_REPORT_OPTION;
  
      procedure SET_FACILITY_TRACE_OPTION (TRACE_OPTION : in UTILITY.OPTION) is
      begin
         TRC_OPTION := TRACE_OPTION;
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "SET FACILITY TRACE OPTION ON", UTILITY.LF);
         end if;
--         W.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
--         F.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
      end SET_FACILITY_TRACE_OPTION;

      procedure SET_FACILITY_DUMP_OPTION (DUMP_OPTION : in UTILITY.OPTION) is
      begin
         DMP_OPTION := DUMP_OPTION;
      end SET_FACILITY_DUMP_OPTION;

      procedure OUTPUT_FACILITY_REPORT is
         RES : FACILITY;
      begin
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "OUTPUT FACILITY REPORT", UTILITY.LF);
         end if;

    -- IF THERE ARE SOME RESOURCES IN THE FACILITY PILE
         if not F.QUEUE_IS_EMPTY (FAC_Q) and RPT_OPTION = UTILITY.ON then
            UTILITY.CONTROL_OUTPUT;
            new_line;
            put ("FACILITY RESOURCE REPORT           simulation time = ");
            put (SIMULATION.CURRENT_SIMULATION_TIME); new_line;
            put_line ("           NUM OF     MEAN      MEAN    STD DEV " &
            "   QUEUE      QUEUE    NUM OF");
            put_line ("RESOURCE  REQUESTS BUSY TIME WAIT TIME WAIT TIME" &
            " LEN. MEAN  LEN. MAX  ENTRIES");
    --  STEP THROUGH FACILITY PILE
            F.FIRST_IN_QUEUE (FAC_Q, RES);
            for I in 1 .. F.LENGTH_OF_QUEUE (FAC_Q) loop
               RES.REPORT;
               F.NEXT_IN_QUEUE (FAC_Q, RES);
            end loop;
            new_line;
            UTILITY.RELEASE_OUTPUT_CONTROL;
         end if;
      end OUTPUT_FACILITY_REPORT;

      procedure OUTPUT_FACILITY_DUMP is
         RES : FACILITY;
      begin
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "OUTPUT FACILITY DUMP", UTILITY.LF);
         end if;

    -- IF THERE ARE SOME RESOURCES IN THE FACILITY PILE
         if not F.QUEUE_IS_EMPTY (FAC_Q) and DMP_OPTION = UTILITY.ON then
            UTILITY.CONTROL_OUTPUT;
            new_line;
            put ("FACILITY RESOURCE DUMP             simulation time = ");
            put (SIMULATION.CURRENT_SIMULATION_TIME); new_line;
    --  STEP THROUGH FACILITY PILE
            F.FIRST_IN_QUEUE (FAC_Q, RES);
            for I in 1 .. F.LENGTH_OF_QUEUE (FAC_Q) loop
               RES.DUMP;
               F.NEXT_IN_QUEUE (FAC_Q, RES);
            end loop;
            new_line;
            UTILITY.RELEASE_OUTPUT_CONTROL;
         end if;
      end OUTPUT_FACILITY_DUMP;


   begin
      F.CREATE_QUEUE (FAC_Q, "FAC_Q");
   end FACILITIES;

--===========================================================================


   package body MESSAGES is

      --======================
      -- MESSAGES DECLARATIONS
      --======================

      TRC_OPTION : UTILITY.OPTION := UTILITY.OFF;
      RPT_OPTION : UTILITY.OPTION := UTILITY.ON;
      DMP_OPTION : UTILITY.OPTION := UTILITY.OFF;

      type MSG_REC is record
         JOB      : SIMULATION.PROCESS;
         PRIORITY : float;
         TIME     : float;
         JOB_NAME : UTILITY.CHAR_STRING;
      end record;
      type MSG_PTR is access MSG_REC;
      procedure FREE_MSG is new UNCHECKED_DEALLOCATION (MSG_REC, MSG_PTR);


      --====================
      -- MESSAGES OPERATIONS
      --====================

      function MSG_COMP (X,Y : MSG_PTR) return boolean is
      begin
         if X.PRIORITY < Y.PRIORITY then
            return TRUE;
         elsif X.PRIORITY = Y.PRIORITY and X.TIME < Y.TIME then
            return TRUE;
         else
            return FALSE;
         end if;
      end MSG_COMP;

      function MESS_COMP (X,Y : MESSAGE) return boolean is
      begin
         return TRUE;
      end MESS_COMP;

      function AVAIL_COMP (X,Y : POINTER) return boolean is
      begin
         return FALSE;
      end AVAIL_COMP;

      package W is new QUEUES ("MSG_WAIT", MSG_PTR, MSG_COMP);
      package M is new QUEUES ("MESSAGEQ", MESSAGE, MESS_COMP);
      package A is new QUEUES ("MSGAVAIL", POINTER, AVAIL_COMP);

      package SUB is
         MSG_Q : M.QUEUE;
      end SUB;
      use SUB;

      procedure FREE_MESSAGE is new UNCHECKED_DEALLOCATION 
         (MESSAGE_RESOURCE, MESSAGE);

      task body MESSAGE_RESOURCE is
    -- DECLARE MESSAGE QUEUE
         WAIT : W.QUEUE;
         AVAIL : A.QUEUE;
         NO_OF_REQUESTS, ENTRIES, MAX_LENGTH : integer := 0;
         PRI, DTIME, CREATE_TIME, TIME_LAST, SUM_TIME_X_LENGTH,
            SUM_OF_WAIT, SUM_OF_WAIT2 : float := 0.0;
         Q_JOB : SIMULATION.PROCESS;
         MSG_NAME : UTILITY.CHAR_STRING;
         MSG : MSG_PTR;
         ENABLE_FLAG : boolean := TRUE;
      begin
         accept SETUP (NAME : in string) do
            CREATE_TIME := SIMULATION.CURRENT_SIMULATION_TIME;
            MSG_NAME := UTILITY.STRING_MATCH (NAME, 8);
            W.CREATE_QUEUE (WAIT, MSG_NAME);
            A.CREATE_QUEUE (AVAIL, MSG_NAME);
         end SETUP;

         loop
            select
               accept RECEIVE (DATA : in out POINTER;
                               RESPONSE : in out ALLOC_TYPE) do
                  if RESPONSE = FIRST_REQUEST then
                     NO_OF_REQUESTS := NO_OF_REQUESTS + 1;
                  end if;
                  if A.LENGTH_OF_QUEUE (AVAIL) = 0 then
                     MSG := new MSG_REC;
                     MSG.JOB := SIMULATION.CURRENT_PROCESS;
                     MSG.JOB_NAME := SIMULATION.CURRENT_PROCESS_NAME;
                     MSG.PRIORITY := SIMULATION.CURRENT_PROCESS_PRIORITY;
                     MSG.TIME := SIMULATION.CURRENT_SIMULATION_TIME;
                     SUM_TIME_X_LENGTH := SUM_TIME_X_LENGTH +
                        float (W.LENGTH_OF_QUEUE (WAIT)) * 
                        (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                     TIME_LAST := SIMULATION.CURRENT_SIMULATION_TIME;
                     W.INSERT_QUEUE (WAIT, MSG);
                     RESPONSE := WAITING;
                     ENTRIES := ENTRIES + 1;
                     if W.LENGTH_OF_QUEUE (WAIT) > MAX_LENGTH then
                        MAX_LENGTH := W.LENGTH_OF_QUEUE (WAIT);
                     end if;
                     if TRC_OPTION = UTILITY.ON then
                        UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                           SIMULATION.CURRENT_PROCESS_NAME,
                           "waiting for message " & MSG_NAME, UTILITY.LF);
                     end if;
                     DATA := 0;
                  else
                     RESPONSE := ALLOCATED;
                     if TRC_OPTION = UTILITY.ON then
                        UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                           SIMULATION.CURRENT_PROCESS_NAME,
                           "received message " & MSG_NAME, UTILITY.LF);
                     end if;
       -- TAKE TOP MESSAGE OFF  LIST
                     A.REMOVE_QUEUE_FIRST (AVAIL, DATA);
                  end if;
               end RECEIVE;
            or
               accept SEND (DATA : in POINTER) do
                  if TRC_OPTION = UTILITY.ON then
                     UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                        SIMULATION.CURRENT_PROCESS_NAME,
                        "sent message " & MSG_NAME, UTILITY.LF);
                  end if;
              -- PUT MESSAGE IN LIST
                  A.INSERT_QUEUE (AVAIL, DATA);
              -- IF SOMEONE IS WAITING
                  if not W.QUEUE_IS_EMPTY (WAIT) then
              -- TAKE TOP PROCESS OFF WAITING LIST
                     W.REMOVE_QUEUE_FIRST (WAIT, MSG);
                     SIMULATION.UNBLOCK (MSG.JOB);
                     DTIME := SIMULATION.CURRENT_SIMULATION_TIME - MSG.TIME;
                     SUM_OF_WAIT := SUM_OF_WAIT + DTIME;
                     SUM_OF_WAIT2 := SUM_OF_WAIT2 + DTIME * DTIME;
                     SUM_TIME_X_LENGTH := SUM_TIME_X_LENGTH +
                        float (W.LENGTH_OF_QUEUE (WAIT)) * 
                        (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                     TIME_LAST := SIMULATION.CURRENT_SIMULATION_TIME;
                     FREE_MSG (MSG);
                  end if;
               end SEND;
            or
               accept STATUS (STATE : out boolean) do
                  STATE := ENABLE_FLAG;
               end STATUS;
            or
               accept SEND_COUNT (NUMBER : out natural) do
                  NUMBER := A.LENGTH_OF_QUEUE (AVAIL);
               end SEND_COUNT;
            or
               accept RECEIVE_COUNT (NUMBER : out natural) do
                  NUMBER := W.LENGTH_OF_QUEUE (WAIT);
               end RECEIVE_COUNT;
            or
               accept ALTER (FLAG : in boolean) do
                  ENABLE_FLAG := FLAG;
                  if TRC_OPTION = UTILITY.ON then
                     UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                                     SIMULATION.CURRENT_PROCESS_NAME,
                                     "message resource " & MSG_NAME,
                                     UTILITY.NO_LF);
                     if ENABLE_FLAG = TRUE then
                        put (" ENABLED");
                     else
                        put (" DISABLED");
                     end if;
                     new_line;
                  end if;
               end ALTER;
            or
               accept REPORT do
                  declare 
                     SUM_WAIT, SUM_WAIT2, SUM_TIME : float := 0.0;
                     ZERO : constant float := 0.0;
                  begin
                     put (MSG_NAME & "   ");                        -- NAME
                     put (NO_OF_REQUESTS, 8);                       -- REQUESTS
                     if ENTRIES > 0 then
                        if not W.QUEUE_IS_EMPTY (WAIT) then
                           W.FIRST_IN_QUEUE (WAIT, MSG);
                           for I in 1 .. W.LENGTH_OF_QUEUE (WAIT) loop
                              DTIME := SIMULATION.CURRENT_SIMULATION_TIME - 
                                       MSG.TIME;
                              SUM_WAIT := SUM_OF_WAIT + DTIME;
                              SUM_WAIT2 := SUM_OF_WAIT2 + DTIME * DTIME;
                              SUM_TIME := SUM_TIME_X_LENGTH +
                              float (W.LENGTH_OF_QUEUE (WAIT)) * 
                              (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                           end loop;
                        else
                           SUM_WAIT := SUM_OF_WAIT;
                           SUM_WAIT2 := SUM_OF_WAIT2;
                           SUM_TIME := SUM_TIME_X_LENGTH;
                        end if;
                        put ("   ");
                        put (SUM_WAIT / float (ENTRIES), 1,2,3);    -- WAIT AVG
                        put ("   ");
                        if ENTRIES = 1 or else 
                           SUM_WAIT2 <= SUM_WAIT * SUM_WAIT / float (ENTRIES) 
                           then 
                           put (ZERO, 1, 2, 3);
                        else                                        -- WAIT STD
                           put (MATH.SQRT ((SUM_WAIT2 -  SUM_WAIT * SUM_WAIT / 
                           float (ENTRIES)) / float (ENTRIES - 1)), 1,2,3); 
                        end if;
                        put ("   ");
                        if SIMULATION.CURRENT_SIMULATION_TIME = 0.0 then
                           put (ZERO, 1, 2, 3);
                        else                                  -- WAIT Q AVG LEN
                           put (SUM_TIME / 
                                SIMULATION.CURRENT_SIMULATION_TIME, 1, 2, 3);
                        end if;
                        put ("   ");
                        put (MAX_LENGTH, 7);                  -- WAIT Q MAX LEN
                        put ("   ");
                        put (ENTRIES, 7);                     -- WAIT Q ENTRIES
                     end if;
                     new_line;
                  end;
               end REPORT;
            or
               accept DUMP do
                  new_line; 
                  put ("  NAME: " & MSG_NAME & "     NUMBER AVAILABLE:  ");
                  put (A.LENGTH_OF_QUEUE (AVAIL), 4);
                  new_line;
        -- STEP THROUGH WAITING PILE
                  put ("                     PROCESSES WAITING: ");
                  if not W.QUEUE_IS_EMPTY (WAIT) then
                     W.FIRST_IN_QUEUE (WAIT, MSG);
                     put (MSG.JOB_NAME); 
                     put (" since "); put (MSG.TIME); new_line;
                     for I in 2 .. W.LENGTH_OF_QUEUE (WAIT) loop
                        W.NEXT_IN_QUEUE (WAIT, MSG);
                        put ("                                        ");
                        put (MSG.JOB_NAME); 
                        put (" since "); put (MSG.TIME); new_line;
                     end loop;
                  else
                     put_line ("NONE");
                  end if;
                  new_line;
               end DUMP;
            or
               terminate;
            end select;
         end loop;
      exception
         when others =>
            SIMULATION.SIMULATOR_ERROR ("MESSAGE RESOURCE " & MSG_NAME & 
               " EXCEPTION", UTILITY.FATAL);
      end MESSAGE_RESOURCE;


      procedure CREATE_MESSAGE (MESSAGE_REF : in out MESSAGE;
                                NAME : in string) is
      begin
         MESSAGE_REF := new MESSAGE_RESOURCE;
  --  PUT IN MSG PILE
         M.INSERT_QUEUE (MSG_Q, MESSAGE_REF);
         MESSAGE_REF.SETUP (NAME);
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                            SIMULATION.CURRENT_PROCESS_NAME,
                            "message " & NAME & " created", UTILITY.LF);
         end if;
      end CREATE_MESSAGE;


      procedure DESTROY_MESSAGE (MESSAGE_REF : in out MESSAGE) is
         RES : MESSAGE;
      begin
         if MESSAGE_REF = null then
            raise MESSAGE_DOES_NOT_EXIST;
         end if;
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                            SIMULATION.CURRENT_PROCESS_NAME,
                            "message destroyed", UTILITY.LF);
         end if;
-- step through message pile to find and dequeue this message
         M.FIRST_IN_QUEUE (MSG_Q, RES);
         for I in 1 .. M.LENGTH_OF_QUEUE (MSG_Q) loop
            if RES = MESSAGE_REF then
               M.REMOVE_QUEUE_CURRENT (MSG_Q);
               exit;
            end if;
            M.NEXT_IN_QUEUE (MSG_Q, RES);
         end loop;
         FREE_MESSAGE (MESSAGE_REF);
      end DESTROY_MESSAGE;


      procedure MODIFY_MESSAGE (MESSAGE_REF : in out MESSAGE;
                                ENABLE_FLAG : in boolean) is
      begin
         if MESSAGE_REF = null then
            raise MESSAGE_DOES_NOT_EXIST;
         end if;
         MESSAGE_REF.ALTER (ENABLE_FLAG);
      end MODIFY_MESSAGE;


      function MESSAGE_ENABLED (MESSAGE_REF : in MESSAGE) return boolean is
         ENABLE_FLAG : boolean;
      begin
         if MESSAGE_REF = null then
            raise MESSAGE_DOES_NOT_EXIST;
         end if;
         MESSAGE_REF.STATUS (ENABLE_FLAG);
         return ENABLE_FLAG;
      end MESSAGE_ENABLED;


      function CURRENT_MESSAGE_COUNT (MESSAGE_REF : in MESSAGE) 
                                     return natural is
         EXCESS_COUNT : natural;
      begin
         MESSAGE_REF.SEND_COUNT (EXCESS_COUNT);
         return EXCESS_COUNT;
      end CURRENT_MESSAGE_COUNT;


      function NUMBER_WAITING_FOR_MESSAGE (MESSAGE_REF : in MESSAGE) 
                                          return natural is
         NUMBER : natural;
      begin
         MESSAGE_REF.RECEIVE_COUNT (NUMBER);
         return NUMBER;
      end NUMBER_WAITING_FOR_MESSAGE;


      procedure SET_MESSAGE_REPORT_OPTION 
                (REPORT_OPTION : in UTILITY.OPTION) is
      begin
         RPT_OPTION := REPORT_OPTION;
      end SET_MESSAGE_REPORT_OPTION;

  
      procedure SET_MESSAGE_TRACE_OPTION (TRACE_OPTION : in UTILITY.OPTION) is
      begin
         TRC_OPTION := TRACE_OPTION;
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "SET MESSAGE TRACE OPTION ON", UTILITY.LF);
         end if;
--         W.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
--         M.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
--         A.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
      end SET_MESSAGE_TRACE_OPTION;


      procedure SET_MESSAGE_DUMP_OPTION (DUMP_OPTION : in UTILITY.OPTION) is
      begin
         DMP_OPTION := DUMP_OPTION;
      end SET_MESSAGE_DUMP_OPTION;


      procedure OUTPUT_MESSAGE_REPORT is
         MSG : MESSAGE;
      begin
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "OUTPUT MESSAGE REPORT", UTILITY.LF);
         end if;

   -- IF THERE ARE MESSAGES IN THE MESSAGE PILE
         if not M.QUEUE_IS_EMPTY (MSG_Q) and RPT_OPTION = UTILITY.ON then
            UTILITY.CONTROL_OUTPUT;
            new_line;
            put ("MESSAGE RESOURCE REPORT           simulation time = ");
            put (SIMULATION.CURRENT_SIMULATION_TIME); new_line;
            put_line ("            NUM OF                          WAIT Q  " &
                      "   WAIT Q    WAIT Q");
            put_line ("  NAME     REQUESTS   WAIT AVG   WAIT STD   AVG LEN." &
                      "   MAX LEN   ENTRIES");
      --STEP THROUGH THE MESSAGE PILE
            M.FIRST_IN_QUEUE (MSG_Q, MSG);
            for I in 1 .. M.LENGTH_OF_QUEUE (MSG_Q) loop
               MSG.REPORT;
               M.NEXT_IN_QUEUE (MSG_Q, MSG);
            end loop;
            new_line;
            UTILITY.RELEASE_OUTPUT_CONTROL;
         end if;
      end OUTPUT_MESSAGE_REPORT;


      procedure OUTPUT_MESSAGE_DUMP is
         MSG : MESSAGE;
      begin
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "OUTPUT MESSAGE DUMP", UTILITY.LF);
         end if;

   -- IF THERE ARE MESSAGES IN THE MESSAGE PILE
         if not M.QUEUE_IS_EMPTY (MSG_Q) and DMP_OPTION = UTILITY.ON then
            UTILITY.CONTROL_OUTPUT;
            new_line;
            put ("MESSAGE RESOURCE DUMP             simulation time = ");
            put (SIMULATION.CURRENT_SIMULATION_TIME); new_line;
      --STEP THROUGH THE MESSAGE PILE
            M.FIRST_IN_QUEUE (MSG_Q, MSG);
            for I in 1 .. M.LENGTH_OF_QUEUE (MSG_Q) loop
               MSG.DUMP;
               M.NEXT_IN_QUEUE (MSG_Q, MSG);
            end loop;
            new_line;
            UTILITY.RELEASE_OUTPUT_CONTROL;
         end if;
      end OUTPUT_MESSAGE_DUMP;


      package body MESSAGE_CREATOR is

         MESSAGE_COUNTER : POINTER := 0;

         type INTERNAL_RECORD is
            record
               MESSAGE_ID : natural;
               MESSAGE    : MESSAGE_TYPE;
            end record;
         type INTERNAL_PTR is access INTERNAL_RECORD;

         procedure FREE_INTERNAL is new UNCHECKED_DEALLOCATION
            (INTERNAL_RECORD, INTERNAL_PTR);

         function INT_COMPARE (X, Y : in INTERNAL_PTR) return boolean is
         begin
            return false;
         end INT_COMPARE;

         package INTQ is new QUEUES ("INTMESSQ", INTERNAL_PTR, INT_COMPARE);

-- declare INT_Q in a little package
         package INTQL is
            INT_Q : INTQ.QUEUE;
         end INTQL;
         use INTQL;

         procedure RECEIVE_MESSAGE (MESSAGE_REF : in out MESSAGE;
                                    DATA : out MESSAGE_TYPE) is
            INTERNAL : INTERNAL_PTR;
            RESPONSE : ALLOC_TYPE := FIRST_REQUEST;
            I : POINTER := 0;
         begin
            if not MESSAGE_ENABLED (MESSAGE_REF) then
               raise MESSAGE_IS_DISABLED;
            end if;
            while RESPONSE /= ALLOCATED loop
               MESSAGE_REF.RECEIVE (I,RESPONSE);
               exit when RESPONSE = ALLOCATED;
               SIMULATION.BLOCK;
            end loop;

            INTQ.FIRST_IN_QUEUE (INT_Q, INTERNAL);
            for J in 1 .. INTQ.LENGTH_OF_QUEUE (INT_Q) loop
               exit when INTERNAL.MESSAGE_ID = I;
               INTQ.NEXT_IN_QUEUE (INT_Q, INTERNAL);
            end loop;
            DATA := INTERNAL.MESSAGE;
            INTQ.REMOVE_QUEUE_CURRENT (INT_Q);
            FREE_INTERNAL (INTERNAL);
         end RECEIVE_MESSAGE;

         procedure SEND_MESSAGE (MESSAGE_REF : in out MESSAGE;
                                 DATA : in MESSAGE_TYPE) is
            INTERNAL : INTERNAL_PTR;
            I : POINTER;
         begin
            if not MESSAGE_ENABLED (MESSAGE_REF) then
               raise MESSAGE_IS_DISABLED;
            end if;

            if MESSAGE_COUNTER = 0 then
               INTQ.CREATE_QUEUE (INT_Q, "INTMESGQ");
            end if;

            MESSAGE_COUNTER := MESSAGE_COUNTER + 1;
            INTERNAL := new INTERNAL_RECORD;
            INTERNAL.MESSAGE_ID := MESSAGE_COUNTER;
            INTERNAL.MESSAGE := DATA;
            INTQ.INSERT_QUEUE (INT_Q, INTERNAL);
            MESSAGE_REF.SEND (MESSAGE_COUNTER);
         end SEND_MESSAGE;

      end MESSAGE_CREATOR;

   begin
      M.CREATE_QUEUE (MSG_Q, "MSG_Q");
   end MESSAGES;


   package body EVENTS is

      --====================
      -- EVENTS DECLARATIONS
      --====================

      EVENT_COUNTER : POINTER := 0;

      TRC_OPTION : UTILITY.OPTION := UTILITY.OFF;
      RPT_OPTION : UTILITY.OPTION := UTILITY.ON;
      DMP_OPTION : UTILITY.OPTION := UTILITY.OFF;

      type EVT_REC is record
         JOB      : SIMULATION.PROCESS;
         PRIORITY : float;
         TIME     : float;
         JOB_NAME : UTILITY.CHAR_STRING;
      end record;
      type EVT_PTR is access EVT_REC;
      procedure FREE_EVT is new UNCHECKED_DEALLOCATION (EVT_REC, EVT_PTR);


      --==================
      -- EVENTS OPERATIONS
      --==================

      function WAIT_COMP (X,Y : EVT_PTR) return boolean is
      begin
         if X.PRIORITY < Y.PRIORITY then
            return TRUE;
         elsif X.PRIORITY = Y.PRIORITY and X.TIME < Y.TIME then
            return TRUE;
         else
            return FALSE;
         end if;
      end WAIT_COMP;

      function EVENT_COMP (X,Y : EVENT) return boolean is
      begin
         return TRUE;
      end EVENT_COMP;

      function AVAIL_COMP (X,Y : POINTER) return boolean is
      begin
         return FALSE;
      end AVAIL_COMP;

      package W is new QUEUES ("EVT_WAIT", EVT_PTR, WAIT_COMP);
      package E is new QUEUES ("RES.EVTQ", EVENT, EVENT_COMP);
      package A is new QUEUES ("EVTAVAIL", POINTER, AVAIL_COMP);

      package SUB is
         EVT_Q : E.QUEUE;
      end SUB;
      use SUB;

      procedure FREE_EVENT is new UNCHECKED_DEALLOCATION 
         (EVENT_RESOURCE, EVENT);

      task body EVENT_RESOURCE is
    -- DECLARE EVENT QUEUE
         WAIT_Q : W.QUEUE;
         AVAIL : A.QUEUE;
         NO_OF_REQUESTS, ENTRIES, MAX_LENGTH : integer := 0;
         PRI, DTIME, CREATE_TIME, TIME_LAST, SUM_TIME_X_LENGTH,
            SUM_OF_WAIT, SUM_OF_WAIT2 : float := 0.0;
         Q_JOB : SIMULATION.PROCESS;
         EVT_NAME : UTILITY.CHAR_STRING;
         EVT : EVT_PTR;
         ENABLE_FLAG : boolean := TRUE;
      begin
         accept SETUP (NAME : in string) do
            CREATE_TIME := SIMULATION.CURRENT_SIMULATION_TIME;
            EVT_NAME := UTILITY.STRING_MATCH (NAME, 8);
            W.CREATE_QUEUE (WAIT_Q, EVT_NAME);
            A.CREATE_QUEUE (AVAIL, EVT_NAME);
         end SETUP;

         loop
            select
               accept WAIT (PTR : in out POINTER; 
                            RESPONSE : in out ALLOC_TYPE) do
                  if RESPONSE = FIRST_REQUEST then
                     NO_OF_REQUESTS := NO_OF_REQUESTS + 1;
                  end if;
                  if A.LENGTH_OF_QUEUE (avail) = 0 then
                     EVT := new EVT_REC;
                     EVT.JOB := SIMULATION.CURRENT_PROCESS;
                     EVT.JOB_NAME := SIMULATION.CURRENT_PROCESS_NAME;
                     EVT.PRIORITY := SIMULATION.CURRENT_PROCESS_PRIORITY;
                     EVT.TIME := SIMULATION.CURRENT_SIMULATION_TIME;
                     SUM_TIME_X_LENGTH := SUM_TIME_X_LENGTH +
                        float (W.LENGTH_OF_QUEUE (WAIT_Q)) * 
                        (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                     TIME_LAST := SIMULATION.CURRENT_SIMULATION_TIME;
                     W.INSERT_QUEUE (WAIT_Q, EVT);
                     RESPONSE := WAITING;
                     ENTRIES := ENTRIES + 1;
                     if W.LENGTH_OF_QUEUE (WAIT_Q) > MAX_LENGTH then
                        MAX_LENGTH := W.LENGTH_OF_QUEUE (WAIT_Q);
                     end if;
                     if TRC_OPTION = UTILITY.ON then
                        UTILITY.OUTPUT_TRACE 
                           (SIMULATION.CURRENT_SIMULATION_TIME,
                            SIMULATION.CURRENT_PROCESS_NAME,
                            "waiting for event " & EVT_NAME, UTILITY.LF);
                     end if;
                     PTR := 0;
                  else
                     RESPONSE := ALLOCATED;
                     if TRC_OPTION = UTILITY.ON then
                        UTILITY.OUTPUT_TRACE 
                           (SIMULATION.CURRENT_SIMULATION_TIME,
                            SIMULATION.CURRENT_PROCESS_NAME,
                            "received event " & EVT_NAME, UTILITY.LF);
                     end if;
       -- TAKE TOP EVENT OFF  LIST
                     A.REMOVE_QUEUE_FIRST (AVAIL, PTR);
                  end if;
               end WAIT;
            or
               accept SIGNAL (PTR : in POINTER) do
                  if TRC_OPTION = UTILITY.ON then
                     UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                        SIMULATION.CURRENT_PROCESS_NAME,
                        "signal event " & EVT_NAME, UTILITY.LF);
                  end if;
              -- PUT EVENT IN LIST
                  A.INSERT_QUEUE (AVAIL, PTR);
              -- IF SOMEONE IS WAITING
                  if not W.QUEUE_IS_EMPTY (WAIT_Q) then
              -- TAKE TOP PROCESS OFF WAITING LIST
                     W.REMOVE_QUEUE_FIRST (WAIT_Q, EVT);
                     SIMULATION.UNBLOCK (EVT.JOB);
                     DTIME := SIMULATION.CURRENT_SIMULATION_TIME - EVT.TIME;
                     SUM_OF_WAIT := SUM_OF_WAIT + DTIME;
                     SUM_OF_WAIT2 := SUM_OF_WAIT2 + DTIME * DTIME;
                     SUM_TIME_X_LENGTH := SUM_TIME_X_LENGTH +
                        float (W.LENGTH_OF_QUEUE (WAIT_Q)) * 
                        (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                     TIME_LAST := SIMULATION.CURRENT_SIMULATION_TIME;
                     FREE_EVT (EVT);
                  end if;
               end SIGNAL;
            or
               accept STATUS (STATE : out boolean) do
                  STATE := ENABLE_FLAG;
               end STATUS;
            or
               accept SIGNAL_COUNT (NUMBER : out natural) do
                  NUMBER := A.LENGTH_OF_QUEUE (AVAIL);
               end SIGNAL_COUNT;
            or
               accept WAIT_COUNT (NUMBER : out natural) do
                  NUMBER := W.LENGTH_OF_QUEUE (WAIT_Q);
               end WAIT_COUNT;
            or
               accept ALTER (FLAG : in boolean) do
                  ENABLE_FLAG := FLAG;
                  if TRC_OPTION = UTILITY.ON then
                     UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                                     SIMULATION.CURRENT_PROCESS_NAME,
                                     "event resource " & EVT_NAME,
                                     UTILITY.NO_LF);
                     if ENABLE_FLAG = TRUE then
                        put (" ENABLED");
                     else
                        put (" DISABLED");
                     end if;
                     new_line;
                  end if;
               end ALTER;
            or
               accept REPORT do
                  declare 
                     SUM_WAIT, SUM_WAIT2, SUM_TIME : float := 0.0;
                     ZERO : constant float := 0.0;
                  begin
                     put (EVT_NAME & "   ");                        -- NAME
                     put (NO_OF_REQUESTS, 8);                       -- REQUESTS
                     if ENTRIES > 0 then
                        if not W.QUEUE_IS_EMPTY (WAIT_Q) then
                           W.FIRST_IN_QUEUE (WAIT_Q, EVT);
                           for I in 1 .. W.LENGTH_OF_QUEUE (WAIT_Q) loop
                              DTIME := SIMULATION.CURRENT_SIMULATION_TIME - 
                                       EVT.TIME;
                              SUM_WAIT := SUM_OF_WAIT + DTIME;
                              SUM_WAIT2 := SUM_OF_WAIT2 + DTIME * DTIME;
                              SUM_TIME := SUM_TIME_X_LENGTH +
                              float (W.LENGTH_OF_QUEUE (WAIT_Q)) * 
                              (SIMULATION.CURRENT_SIMULATION_TIME - TIME_LAST);
                              W.NEXT_IN_QUEUE (WAIT_Q, EVT);
                           end loop;
                        else
                           SUM_WAIT := SUM_OF_WAIT;
                           SUM_WAIT2 := SUM_OF_WAIT2;
                           SUM_TIME := SUM_TIME_X_LENGTH;
                        end if;
                        put ("   ");
                        put (SUM_WAIT / float (ENTRIES), 1,2,3);    -- WAIT AVG
                        put ("   ");
                        if ENTRIES = 1 or else 
                           SUM_WAIT2 <= SUM_WAIT * SUM_WAIT / float (ENTRIES) 
                           then 
                           put (ZERO, 1, 2, 3);
                        else                                        -- WAIT STD
                           put (MATH.SQRT ((SUM_WAIT2 -  SUM_WAIT * SUM_WAIT / 
                           float (ENTRIES)) / float (ENTRIES - 1)), 1,2,3); 
                        end if;
                        put ("   ");
                        if SIMULATION.CURRENT_SIMULATION_TIME = 0.0 then
                           put (ZERO, 1, 2, 3);
                        else                                  -- WAIT Q AVG LEN
                           put (SUM_TIME / 
                                SIMULATION.CURRENT_SIMULATION_TIME, 1, 2, 3);
                        end if;
                        put ("   ");
                        put (MAX_LENGTH, 7);                  -- WAIT Q MAX LEN
                        put ("   ");
                        put (ENTRIES, 7);                     -- WAIT Q ENTRIES
                     end if;
                     new_line;
                  end;
               end REPORT;
            or
               accept DUMP do
                  new_line; 
                  put ("  NAME: " & EVT_NAME & "     NUMBER AVAILABLE:  ");
                  put (A.LENGTH_OF_QUEUE (AVAIL), 4);
                  new_line;
        -- STEP THROUGH WAITING PILE
                  put ("                     PROCESSES WAITING: ");
                  if not W.QUEUE_IS_EMPTY (WAIT_Q) then
                     W.FIRST_IN_QUEUE (WAIT_Q, EVT);
                     put (EVT.JOB_NAME); 
                     put (" since "); put (EVT.TIME); new_line;
                     for I in 2 .. W.LENGTH_OF_QUEUE (WAIT_Q) loop
                        W.NEXT_IN_QUEUE (WAIT_Q, EVT);
                        put ("                                        ");
                        put (EVT.JOB_NAME); 
                        put (" since "); put (EVT.TIME); new_line;
                     end loop;
                  else
                     put_line ("NONE");
                  end if;
                  new_line;
               end DUMP;
            or
               terminate;
            end select;
         end loop;
      exception
         when others =>
            SIMULATION.SIMULATOR_ERROR ("EVENT RESOURCE " & EVT_NAME & 
               " EXCEPTION", UTILITY.FATAL);
      end EVENT_RESOURCE;


      procedure CREATE_EVENT (EVENT_REF : in out EVENT;
                              EVENT_NAME : in string) is
      begin
         EVENT_REF := new EVENT_RESOURCE;
  --  PUT IN EVT PILE
         E.INSERT_QUEUE (EVT_Q, EVENT_REF);
         EVENT_REF.SETUP (EVENT_NAME);
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                          SIMULATION.CURRENT_PROCESS_NAME,
                          "event " & EVENT_NAME & " created", UTILITY.LF);
         end if;
      end CREATE_EVENT;


      procedure WAIT_EVENT (EVENT_REF : in out EVENT) is
         RESPONSE : ALLOC_TYPE := FIRST_REQUEST;
         PTR : POINTER := 0;
      begin
         if not EVENT_ENABLED (EVENT_REF) then
            raise EVENT_IS_DISABLED;
         end if;
         while RESPONSE /= ALLOCATED loop
            EVENT_REF.WAIT (PTR, RESPONSE);
            exit when RESPONSE = ALLOCATED;
            SIMULATION.BLOCK;
            end loop;
      end WAIT_EVENT;


      procedure SIGNAL_EVENT (EVENT_REF : in out EVENT) is
      begin
         if not EVENT_ENABLED (EVENT_REF) then
            raise EVENT_IS_DISABLED;
         end if;
         EVENT_COUNTER := EVENT_COUNTER + 1;
         EVENT_REF.SIGNAL (EVENT_COUNTER);
      end SIGNAL_EVENT;


      procedure DESTROY_EVENT (EVENT_REF : in out EVENT) is
         RES : EVENT;
      begin
         if EVENT_REF = null then
            raise EVENT_DOES_NOT_EXIST;
         end if;
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
                            SIMULATION.CURRENT_PROCESS_NAME,
                            "event destroyed", UTILITY.LF);
         end if;
-- step through event pile to find and dequeue this event
         E.FIRST_IN_QUEUE (EVT_Q, RES);
         for I in 1 .. E.LENGTH_OF_QUEUE (EVT_Q) loop
            if RES = EVENT_REF then
               E.REMOVE_QUEUE_CURRENT (EVT_Q);
               exit;
            end if;
            E.NEXT_IN_QUEUE (EVT_Q, RES);
         end loop;
         FREE_EVENT (EVENT_REF);
      end DESTROY_EVENT;


      procedure MODIFY_EVENT (EVENT_REF : in out EVENT;
                                ENABLE_FLAG : in boolean) is
      begin
         if EVENT_REF = null then
            raise EVENT_DOES_NOT_EXIST;
         end if;
         EVENT_REF.ALTER (ENABLE_FLAG);
      end MODIFY_EVENT;


      function EVENT_ENABLED (EVENT_REF : in EVENT) return boolean is
         ENABLE_FLAG : boolean;
      begin
         if EVENT_REF = null then
            raise EVENT_DOES_NOT_EXIST;
         end if;
         EVENT_REF.STATUS (ENABLE_FLAG);
         return ENABLE_FLAG;
      end EVENT_ENABLED;


      function CURRENT_EVENT_COUNT (EVENT_REF : in EVENT) return natural is
         EXCESS_COUNT : natural;
      begin
         EVENT_REF.SIGNAL_COUNT (EXCESS_COUNT);
         return EXCESS_COUNT;
      end CURRENT_EVENT_COUNT;


      function NUMBER_WAITING_FOR_EVENT (EVENT_REF : in EVENT) 
                                         return natural is
         NUMBER : natural;
      begin
         EVENT_REF.WAIT_COUNT (NUMBER);
         return NUMBER;
      end NUMBER_WAITING_FOR_EVENT;


      procedure SET_EVENT_REPORT_OPTION 
                (REPORT_OPTION : in UTILITY.OPTION) is
      begin
         RPT_OPTION := REPORT_OPTION;
      end SET_EVENT_REPORT_OPTION;

  
      procedure SET_EVENT_TRACE_OPTION (TRACE_OPTION : in UTILITY.OPTION) is
      begin
         TRC_OPTION := TRACE_OPTION;
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "SET EVENT TRACE OPTION ON", UTILITY.LF);
         end if;
--         W.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
--         M.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
--         A.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
      end SET_EVENT_TRACE_OPTION;


      procedure SET_EVENT_DUMP_OPTION (DUMP_OPTION : in UTILITY.OPTION) is
      begin
         DMP_OPTION := DUMP_OPTION;
      end SET_EVENT_DUMP_OPTION;


      procedure OUTPUT_EVENT_REPORT is
         EVT : EVENT;
      begin
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "OUTPUT EVENT REPORT", UTILITY.LF);
         end if;

   -- IF THERE ARE EVENTS IN THE EVENT PILE
         if not E.QUEUE_IS_EMPTY (EVT_Q) and RPT_OPTION = UTILITY.ON then
            UTILITY.CONTROL_OUTPUT;
            new_line;
            put ("EVENT RESOURCE REPORT           simulation time = ");
            put (SIMULATION.CURRENT_SIMULATION_TIME); new_line;
            put_line ("            NUM OF                          WAIT Q  " &
                      "   WAIT Q    WAIT Q");
            put_line ("  NAME     REQUESTS   WAIT AVG   WAIT STD   AVG LEN." &
                      "   MAX LEN   ENTRIES");
      --STEP THROUGH THE EVENT PILE
            E.FIRST_IN_QUEUE (EVT_Q, EVT);
            for I in 1 .. E.LENGTH_OF_QUEUE (EVT_Q) loop
               EVT.REPORT;
               E.NEXT_IN_QUEUE (EVT_Q, EVT);
            end loop;
            new_line;
            UTILITY.RELEASE_OUTPUT_CONTROL;
         end if;
      end OUTPUT_EVENT_REPORT;


      procedure OUTPUT_EVENT_DUMP is
         EVT : EVENT;
      begin
         if TRC_OPTION = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIMULATION.CURRENT_SIMULATION_TIME,
            SIMULATION.CURRENT_PROCESS_NAME,
            "OUTPUT EVENT DUMP", UTILITY.LF);
         end if;

   -- IF THERE ARE EVENTS IN THE EVENT PILE
         if not E.QUEUE_IS_EMPTY (EVT_Q) and DMP_OPTION = UTILITY.ON then
            UTILITY.CONTROL_OUTPUT;
            new_line;
            put ("EVENT RESOURCE DUMP             simulation time = ");
            put (SIMULATION.CURRENT_SIMULATION_TIME); new_line;
      --STEP THROUGH THE EVENT PILE
            E.FIRST_IN_QUEUE (EVT_Q, EVT);
            for I in 1 .. E.LENGTH_OF_QUEUE (EVT_Q) loop
               EVT.DUMP;
               E.NEXT_IN_QUEUE (EVT_Q, EVT);
            end loop;
            new_line;
            UTILITY.RELEASE_OUTPUT_CONTROL;
         end if;
      end OUTPUT_EVENT_DUMP;


   begin
      E.CREATE_QUEUE (EVT_Q, "EVT_Q");
   end EVENTS;


   --=====================
   -- RESOURCES PROCEDURES
   --=====================

   procedure OUTPUT_RESOURCE_REPORTS is
   begin
      STORAGES.OUTPUT_STORAGE_REPORT;
      FACILITIES.OUTPUT_FACILITY_REPORT;
      MESSAGES.OUTPUT_MESSAGE_REPORT;
      EVENTS.OUTPUT_EVENT_REPORT;
   end OUTPUT_RESOURCE_REPORTS;

   procedure OUTPUT_RESOURCE_DUMPS is
   begin
      STORAGES.OUTPUT_STORAGE_DUMP;
      FACILITIES.OUTPUT_FACILITY_DUMP;
      MESSAGES.OUTPUT_MESSAGE_DUMP;
      EVENTS.OUTPUT_EVENT_DUMP;
   end OUTPUT_RESOURCE_DUMPS;

end RESOURCES;
