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

package body SIMULATION is

   use UTILITY.REAL_IO, UTILITY.INT_IO;

   -- Current Simulation Time and Simulation Termination Time :
   SIM_TIME  : float := 0.0;
   STOP_TIME : float;

   TOTAL_NO_OF_PROCESSES : natural := 0;
   SUM_OF_EXECUTION_TIMES, SUM_OF_TIMES_SQUARED : float := 0.0;
   MIN_EXECUTION_TIME : float := float'last;
   MAX_EXECUTION_TIME : float := 0.0;

   JOB : PROCESS := null;
   TIME : float;

   REPORT_OPT : UTILITY.OPTION := UTILITY.ON;
   TRACE_OPT  : UTILITY.OPTION := UTILITY.OFF;
   DUMP_OPT   : UTILITY.OPTION := UTILITY.ON;

   procedure FREE_PROCESS is new UNCHECKED_DEALLOCATION (PROCESS_REC, PROCESS);

   -- Synchronization task type :
   -- ---------------------------

   task body SYNCH is
   begin 
      loop
         select
            accept CONTINUE;
            accept WAIT;
         or
            terminate;
         end select;
      end loop;
   exception
      when others =>
         SIMULATOR_ERROR ("SYNCH EXCEPTION", UTILITY.FATAL);
   end SYNCH;


   function COMPARE (PROC_1, PROC_2 : in PROCESS) return boolean is
      -- This function is used for establishing the manner in which
      -- processes are entered into the simulation queue.  Processes
      -- shall be entered into the simulation queue according to
      -- earliest time and lowest priority value.
   begin
      if (PROC_1.ACTIVATION_TIME < PROC_2.ACTIVATION_TIME)
      or else ((PROC_1.ACTIVATION_TIME = PROC_2.ACTIVATION_TIME)
         and then    (PROC_1.PRIORITY < PROC_2.PRIORITY)) then
         return true;
      else
         return false;
      end if;
   end COMPARE;

   package Q is new QUEUES ("EVENTS  ", PROCESS, COMPARE);
      -- Instantiate a queue package, with queue elements
      -- in the form of ptrs. to PROCESSes ordered into the
      -- queue according to the function COMPARE.

--  declare SIM_QUEUE in a little package
   package QL is
      SIM_QUEUE : Q.QUEUE;
   end QL;
   use QL;

   function P_COMPARE (X, Y : in PROCESS) return boolean is
   begin
      return false;
   end P_COMPARE;

   package PQ is new QUEUES ("PROCESSQ", PROCESS, P_COMPARE);

-- declare PROC_Q in a little package
   package PQL is
      PROC_Q : PQ.QUEUE;
   end PQL;
   use PQL;

   function GROUP_COMPARE (X, Y : in GROUP) return boolean is
   begin
      return false;
   end GROUP_COMPARE;

   package GQ is new QUEUES ("GROUP_Q ", GROUP, GROUP_COMPARE);

--  declare GROUP_Q in a little package
   package GQL is
      GROUP_Q : GQ.QUEUE;
   end GQL;
   use GQL;


   procedure COLLECT_OVERALL_STATS (TIME : in float) is
   begin
      if MIN_EXECUTION_TIME > TIME then
         MIN_EXECUTION_TIME := TIME;
      end if;
      if MAX_EXECUTION_TIME < TIME then
         MAX_EXECUTION_TIME := TIME;
      end if;

      SUM_OF_EXECUTION_TIMES := SUM_OF_EXECUTION_TIMES + TIME;
      SUM_OF_TIMES_SQUARED := SUM_OF_TIMES_SQUARED + (TIME * TIME);
      TOTAL_NO_OF_PROCESSES := TOTAL_NO_OF_PROCESSES + 1;
   end COLLECT_OVERALL_STATS;

   procedure COLLECT_GROUP_STATS (G : in out GROUP; TIME : in float) is
   begin
      if G.MIN_GROUP_EXEC_TIME > TIME then
         G.MIN_GROUP_EXEC_TIME := TIME;
      end if;
      if G.MAX_GROUP_EXEC_TIME < TIME then
         G.MAX_GROUP_EXEC_TIME := TIME;
      end if;

      G.SUM_OF_GROUP_EXEC_TIMES := G.SUM_OF_GROUP_EXEC_TIMES + TIME;
      G.SUM_OF_GROUP_SQUARED := G.SUM_OF_GROUP_SQUARED + (TIME * TIME);
      G.NUMBER_TERMINATED := G.NUMBER_TERMINATED + 1;
   end COLLECT_GROUP_STATS;


   procedure PROCESS_LINE (PROC : in PROCESS) is
--    This procedure builds and outputs one line of process information 
--    for OUTPUT_PROCESS_DUMP and TERMINATE_PROCESS trace.
   begin
      put (PROC.GROUP_ID.GROUP_NAME); put ("   ");
      put (PROC.NAME); 
      if PROC.STATUS = ACTIVE then
         put ("    ACTIVE  ");
      elsif PROC.STATUS = INACTIVE then
         put ("  INACTIVE  ");
      elsif PROC.STATUS = DORMANT then
         put ("   DORMANT  ");
      else
         put (" TERMINATED ");
      end if;
      put (PROC.ACTIVATION_TIME, 2, 3, 3); put ("  ");
      put (PROC.PRIORITY, 2, 3, 3); put ("  ");
      put (PROC.START_TIME, 2, 3, 3); put ("  ");
      if PROC.STATUS = TERMINATED then                    -- terminated process
         put (PROC.TERMINATION_TIME - PROC.START_TIME, 2, 3, 3); 
      elsif SIM_TIME >= PROC.START_TIME then              -- started process
         put (SIM_TIME - PROC.START_TIME, 2, 3, 3); 
      end if;
      new_line;
   end PROCESS_LINE;


   -- Simulator Control Task :
   -- ------------------------

   task SCHEDULER is
      entry STARTER (SIMULATION_DURATION : in float := float'last);
      entry UPDATE;
      entry STOP_SIMULATION;
   end SCHEDULER;


   task body SCHEDULER is
      SIMULATION_DONE : boolean := false;
      ABORT_FLAG : UTILITY.OPTION := UTILITY.ON;
   begin

      -- Wait for the simulation start signal :
      accept STARTER (SIMULATION_DURATION : in float := float'last) do
         STOP_TIME := SIMULATION_DURATION;
      
         loop
            -- Indefinitely, for each time through this loop, one
            -- previously DELAYed simulation task is STARTed and
            -- allowed to run until it either calls procedure DELAY,
            -- RETURN_TO_SCHEDULER, CHECKPOINT_SIMULATION, RESTART_
            -- SIMULATION, or STOP_SIMULATION.

            exit when Q.QUEUE_IS_EMPTY (SIM_QUEUE);

            TIME := SIM_TIME;
            Q.REMOVE_QUEUE_FIRST (SIM_QUEUE, JOB);
            SIM_TIME := JOB.ACTIVATION_TIME;

            exit when SIM_TIME >= STOP_TIME;

            if TIME > SIM_TIME then
               SIM_TIME := TIME;
               SIMULATOR_ERROR ("ATTEMPTED TIME REGRESSION", UTILITY.WARNING);
            end if;
            if TRACE_OPT = UTILITY.ON then
               UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
                  "ACTIVATED", UTILITY.LF);
            end if;
            JOB.SIGNAL.CONTINUE;
            JOB.STATUS := ACTIVE;

            select
               accept UPDATE do
                  if JOB.STATUS /= TERMINATED then
                     JOB.STATUS := INACTIVE;
                  end if;
               end UPDATE;
            or
               accept STOP_SIMULATION do
                  SIMULATION_DONE := true;
               end STOP_SIMULATION;
            or
               terminate;
            end select;
            exit when SIMULATION_DONE;
         end loop;

         if TRACE_OPT = UTILITY.ON then 
            UTILITY.OUTPUT_TRACE (SIM_TIME, "SYSTEM  ", "SIMULATION COMPLETED",
                                  UTILITY.LF);
         end if;
         OUTPUT_PROCESS_REPORT;
      end STARTER;

   exception
      when others =>
         SIMULATOR_ERROR ("SCHEDULER EXCEPTION", UTILITY.FATAL);
   end SCHEDULER;


-- Simulator Control Operators :
-- -----------------------------

   procedure START_SIMULATION (SIMULATION_DURATION : in float := float'last) is
   begin
      if TRACE_OPT = UTILITY.ON then
         UTILITY.OUTPUT_TRACE (NUMBER => SIM_TIME, NAME => "SYSTEM  ",
                         TEXT => "START SIMULATION", LF_FLAG => UTILITY.NO_LF);
         put (" for duration of "); put (SIMULATION_DURATION);
         new_line;
      end if;
      if SIMULATION_DURATION <= 0.0 then
         raise DURATION_TIME_ERROR;
      end if;
      SCHEDULER.STARTER (SIMULATION_DURATION);
   end START_SIMULATION;


   procedure STOP_SIMULATION is
   begin
      if TRACE_OPT = UTILITY.ON then
         UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
            "STOP SIMULATION", UTILITY.LF);
      end if;
      SCHEDULER.STOP_SIMULATION;
   end STOP_SIMULATION;


-- Status Operators :
-- ------------------

   function CURRENT_SIMULATION_TIME return float is
   begin
      return SIM_TIME;
   end CURRENT_SIMULATION_TIME;

   function CURRENT_PROCESS_PRIORITY return float is
   begin
      if JOB = null then
         return 0.0;
      else
         return JOB.PRIORITY;
      end if;
   end CURRENT_PROCESS_PRIORITY;

   function CURRENT_PROCESS_NAME return UTILITY.CHAR_STRING is
   begin
      if JOB = null then
         return "SYSTEM  ";
      else
         return JOB.NAME;
      end if;
   end CURRENT_PROCESS_NAME;

   function CURRENT_PROCESS return PROCESS is
   begin
      return JOB;
   end CURRENT_PROCESS;


-- Process Control Operators :
-- ---------------------------

   procedure DELAY_PROCESS (DELAY_TIME : in float) is
   begin
      if JOB = null then
         SIMULATOR_ERROR ("DELAY_PROCESS called, no process is active",
            UTILITY.WARNING);
      else
         JOB.ACTIVATION_TIME := SIM_TIME + DELAY_TIME;
         Q.INSERT_QUEUE (SIM_QUEUE, JOB);
         if TRACE_OPT = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (NUMBER => SIM_TIME, NAME => JOB.NAME,
                            TEXT => "DELAYED FOR", LF_FLAG => UTILITY.NO_LF);
            put (DELAY_TIME);
            new_line;
         end if;
         SCHEDULER.UPDATE;
         JOB.SIGNAL.WAIT;
      end if;
   end DELAY_PROCESS;


   procedure BLOCK is
   begin
      if JOB = null then
         SIMULATOR_ERROR ("BLOCK called, no process is active",
            UTILITY.WARNING);
      else
         if TRACE_OPT = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (NUMBER => SIM_TIME, NAME => JOB.NAME,
               TEXT => "BLOCKED", LF_FLAG => UTILITY.LF);
         end if;
         SCHEDULER.UPDATE;
         JOB.SIGNAL.WAIT;
      end if;
   end BLOCK;


   procedure UNBLOCK (BLOCK_JOB : in PROCESS) is
   begin
      if BLOCK_JOB = null then
         SIMULATOR_ERROR ("process to be UNBLOCKed does not exist",
            UTILITY.WARNING);
      elsif BLOCK_JOB.STATUS /= INACTIVE then
         SIMULATOR_ERROR (BLOCK_JOB.NAME & 
            " specified to be UNBLOCKED is not inactive", UTILITY.WARNING);
      else
         BLOCK_JOB.ACTIVATION_TIME := SIM_TIME;
         Q.INSERT_QUEUE (SIM_QUEUE, BLOCK_JOB);
         if TRACE_OPT = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
               "UNBLOCKED process " & BLOCK_JOB.NAME, UTILITY.LF);
         end if;
      end if;
   end UNBLOCK;


   procedure SUSPEND_PROCESS is
   begin
      if JOB = null then
         SIMULATOR_ERROR ("SUSPEND_PROCESS called, no process is active",
            UTILITY.WARNING);
      else
         if TRACE_OPT = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (NUMBER => SIM_TIME, NAME => JOB.NAME,
               TEXT => "SUSPENDED", LF_FLAG => UTILITY.LF);
         end if;
         SCHEDULER.UPDATE;
         JOB.STATUS := DORMANT;
         JOB.SIGNAL.WAIT;
      end if;
   end SUSPEND_PROCESS;


   procedure RESUME_PROCESS (JOB_RESUME : in  PROCESS;
                             RESUME_TIME, PRIORITY : in float) is 
   begin
      if JOB_RESUME = null then
         SIMULATOR_ERROR ("process to be RESUMED does not exist",
            UTILITY.WARNING);
      elsif JOB_RESUME.STATUS /= DORMANT then
         SIMULATOR_ERROR (JOB_RESUME.NAME & 
         " specified to be RESUMED is not dormant", UTILITY.WARNING);
      else
         if TRACE_OPT = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
               "will RESUME " & JOB_RESUME.NAME & " in ", UTILITY.NO_LF);
            put (RESUME_TIME);
            new_line;
         end if;
         JOB_RESUME.ACTIVATION_TIME := SIM_TIME + RESUME_TIME;
         JOB_RESUME.PRIORITY := PRIORITY;
         Q.INSERT_QUEUE (SIM_QUEUE, JOB_RESUME);
      end if;
   end RESUME_PROCESS;


   procedure TERMINATE_PROCESS is
      EXEC_TIME : float;
      PROC : PROCESS;
   begin
      if JOB = null then
         raise PROCESS_DOES_NOT_EXIST;
      end if;

      -- Gather statistics on current process :
      JOB.STATUS := TERMINATED;
      JOB.TERMINATION_TIME := SIM_TIME;
      EXEC_TIME := SIM_TIME - JOB.START_TIME;
      COLLECT_OVERALL_STATS (EXEC_TIME);
      COLLECT_GROUP_STATS (JOB.GROUP_ID, EXEC_TIME);

-- find and remove the terminated process from the process queue
      PQ.FIRST_IN_QUEUE (PROC_Q, PROC);
      for I in 1 .. PQ.LENGTH_OF_QUEUE (PROC_Q) loop
         if JOB = PROC then
            PQ.REMOVE_QUEUE_CURRENT (PROC_Q);
            exit;
         end if;
         PQ.NEXT_IN_QUEUE (PROC_Q, PROC);
      end loop;

      if TRACE_OPT = UTILITY.ON then
         UTILITY.OUTPUT_TRACE (NUMBER => SIM_TIME, NAME => JOB.NAME,
                        TEXT => "TERMINATE PROCESS", LF_FLAG => UTILITY.LF);
         put_line ("GROUP ID     NAME     STATUS    ACTIV TIME   PRIORITY" &
                   "  START TIME   EXEC TIME");
         PROCESS_LINE (JOB);
         new_line;
      end if;

      SCHEDULER.UPDATE;
      FREE_PROCESS (JOB);
   end TERMINATE_PROCESS;


-- Simulator Output Operators :
-- ----------------------------

   procedure TERMINATED_STATISTICS_LINE (NAME : in UTILITY.CHAR_STRING;
                      NUM : in natural; MIN : in float; MAX : in float; 
                      SUM : in float; SUM_OF_SQUARED : in float) is
--    This procedure builds and outputs one line of information about
--    terminated statistics for OUTPUT_PROCESS_REPORT.
      AVG, STD : float;
   begin
      put (NAME); put ("   ");
      put (NUM, 5);
      if NUM > 0 then
         put ("      ");
         put (MIN, 1, 5, 3); put ("   ");
         put (MAX, 1, 5, 3); put ("   ");
         AVG := SUM / float (NUM);
         put (AVG, 1, 5, 3); put ("   ");
         if  NUM = 1  or else  MIN = MAX  then
            STD := 0.0;
         elsif SUM_OF_SQUARED <= SUM * SUM / float (NUM) then
            STD := 0.0;
         else
            STD := MATH.SQRT ((SUM_OF_SQUARED - SUM * SUM / float (NUM))
                              / float (NUM - 1));
         end if;
         put (STD, 1, 5, 3); 
      end if;
      new_line;
   end TERMINATED_STATISTICS_LINE;


   procedure OUTPUT_PROCESS_REPORT is
      PGROUP : GROUP;
      PROC : PROCESS;
   begin
      if TRACE_OPT = UTILITY.ON then
         UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
            "OUTPUT PROCESS REPORT", UTILITY.LF);
      end if;

      if REPORT_OPT = UTILITY.ON then
         UTILITY.CONTROL_OUTPUT;
         new_line;
         new_line;
         put ("SIMULATION REPORT of terminated process groups,");
         put (" simulation time = ");
         put (SIM_TIME); new_line;
         new_line;
         if GQ.QUEUE_IS_EMPTY (GROUP_Q) then
            put_line ("No processes were ever created"); 
         else
            put_line ("  GROUP     NUMBER       MIN TIME      MAX TIME" & 
                      "      AVG TIME   STAND. DEV");
            TERMINATED_STATISTICS_LINE ("ALL GRPS", TOTAL_NO_OF_PROCESSES,
               MIN_EXECUTION_TIME, MAX_EXECUTION_TIME, SUM_OF_EXECUTION_TIMES,
               SUM_OF_TIMES_SQUARED);
            GQ.FIRST_IN_QUEUE (GROUP_Q, PGROUP);
            loop
               TERMINATED_STATISTICS_LINE (PGROUP.GROUP_NAME, 
                  PGROUP.NUMBER_TERMINATED, PGROUP.MIN_GROUP_EXEC_TIME,
                  PGROUP.MAX_GROUP_EXEC_TIME, PGROUP.SUM_OF_GROUP_EXEC_TIMES,
                  PGROUP.SUM_OF_GROUP_SQUARED);
               exit when GQ.QUEUE_IS_AT_END (GROUP_Q);
               GQ.NEXT_IN_QUEUE (GROUP_Q, PGROUP);        -- next group
            end loop;
         end if;
         new_line;
         UTILITY.RELEASE_OUTPUT_CONTROL;
         Q.OUTPUT_QUEUE_REPORT;                -- EVENTS QUEUE
         PQ.OUTPUT_QUEUE_REPORT;               -- PROCESS QUEUE
         GQ.OUTPUT_QUEUE_REPORT;               -- GROUP QUEUE
      end if;
   end OUTPUT_PROCESS_REPORT;


   procedure OUTPUT_PROCESS_DUMP is
      PGROUP : GROUP;
      PROC : PROCESS;
   begin
      if TRACE_OPT = UTILITY.ON then
         UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
                               "OUTPUT PROCESS DUMP", UTILITY.LF);
      end if;

      UTILITY.CONTROL_OUTPUT;
      new_line;
      new_line;
      put ("SIMULATION DUMP of non-terminated processes,");
      put ("    simulation time = ");
      put (SIM_TIME); new_line;
      new_line;
      if PQ.QUEUE_IS_EMPTY (PROC_Q) then
         put_line ("No processes created or all terminated.");
      else
         put_line ("GROUP ID     NAME     STATUS    ACTIV TIME   PRIORITY" &
                   "  START TIME   EXEC TIME");
         PQ.FIRST_IN_QUEUE (PROC_Q, PROC);
         loop
            PROCESS_LINE (PROC);                     -- output one line
            if PQ.QUEUE_IS_AT_END (PROC_Q) then
               exit;                                 -- all processes done
            end if;
            PQ.NEXT_IN_QUEUE (PROC_Q, PROC);         -- next process
         end loop;
      end if;
      new_line;
      UTILITY.RELEASE_OUTPUT_CONTROL;
   end OUTPUT_PROCESS_DUMP;


   procedure SET_PROCESS_REPORT_OPTION (REPORT_OPTION : in UTILITY.OPTION) is
   begin
      if TRACE_OPT = UTILITY.ON then
         UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
                               "SET PROCESS REPORT", UTILITY.NO_LF);
         if REPORT_OPTION = UTILITY.ON then
            put_line (" ON");
         else
            put_line (" OFF");
         end if;
      end if;

      REPORT_OPT := REPORT_OPTION;
   end SET_PROCESS_REPORT_OPTION;


   procedure SET_PROCESS_TRACE_OPTION (TRACE_OPTION : in UTILITY.OPTION) is
   begin
      TRACE_OPT := TRACE_OPTION;
      if TRACE_OPT = UTILITY.ON then
         UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
                               "SET PROCESS TRACE", UTILITY.NO_LF);
         if TRACE_OPTION = UTILITY.ON then
            put_line (" ON");
         else
            put_line (" OFF");
         end if;
      end if;
--      Q.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
--      PQ.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
--      GQ.SET_QUEUE_TRACE_OPTION (TRACE_OPTION);
   end SET_PROCESS_TRACE_OPTION;


   procedure SET_PROCESS_DUMP_OPTION (DUMP_OPTION : in UTILITY.OPTION) is
   begin
      if TRACE_OPT = UTILITY.ON then
         UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
                               "SET PROCESS DUMP", UTILITY.NO_LF);
         if DUMP_OPTION = UTILITY.ON then
            put_line (" ON");
         else
            put_line (" OFF");
         end if;
      end if;

      DUMP_OPT := DUMP_OPTION;
   end SET_PROCESS_DUMP_OPTION;


   procedure SIMULATOR_ERROR (ERROR_MESSAGE : in string;
                              SEVERITY : in UTILITY.ERROR_SEVERITY) is
   begin
      if TRACE_OPT = UTILITY.ON then
         UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
                               "SIMULATOR ERROR", UTILITY.LF);
      end if;

      new_line;
      put (CURRENT_PROCESS_NAME);
      case SEVERITY is
         when UTILITY.FATAL   => put (" FATAL ERROR -- ");
         when UTILITY.WARNING => put (" NON_FATAL ERROR -- ");
         when others          => null;
      end case;
      put (ERROR_MESSAGE & " at time "); put (SIM_TIME); new_line;
      if SEVERITY = UTILITY.FATAL then 
         if DUMP_OPT = UTILITY.ON then
            Q.SET_QUEUE_REPORT_OPTION (UTILITY.ON);     -- subsequent
            PQ.SET_QUEUE_REPORT_OPTION (UTILITY.ON);    -- report will
            GQ.SET_QUEUE_REPORT_OPTION (UTILITY.ON);    -- show queues
            OUTPUT_PROCESS_DUMP;
         end if;
         STOP_SIMULATION; 
      end if;
   end SIMULATOR_ERROR;


-- Process Operators :
-- -------------------

   package body PROCESS_CREATOR is

      PROCESS_COUNTER : natural := 0;           -- Counter for process_id
      PGROUP  : GROUP;                          -- Group object for package

      -- Task type which instantiates new processes of
      -- a generic type PROCESS_KIND, with ATTRIBUTE_TYPE :
      task type PRE_PROCESS is
         entry START (NEW_JOB : in PROCESS);
      end PRE_PROCESS;
      type PRE_PROCESS_PTR is access PRE_PROCESS;

-- internal housekeeping for a process
      type INT_PROCESS_REC is
         record
            PROCESS_ID : natural;
            ATTRIBUTE  : ATTRIBUTE_TYPE;
            MASTER     : PRE_PROCESS_PTR;
            SIGNAL     : SYNCH_PTR;
         end record;
      type INT_PROCESS_PTR is access INT_PROCESS_REC;

      procedure FREE_INTERNAL is new UNCHECKED_DEALLOCATION 
         (INT_PROCESS_REC, INT_PROCESS_PTR);

      task body PRE_PROCESS is
         N_JOB : PROCESS;
      begin
         loop
            select
               accept START (NEW_JOB : in PROCESS) do
                  N_JOB := NEW_JOB;
               end START;
            or
               terminate;
            end select;
            -- Wait till ready to spawn a new process of type PROCESS_KIND:
            N_JOB.SIGNAL.WAIT;
            declare
               -- Type of ptr. to generic type of process/job :
               type PROCESS_PTR is access PROCESS_KIND;
               PROC  : PROCESS_PTR;
            begin
               PROC := new PROCESS_KIND; 
            end;
         end loop;
      exception
         when others =>
         SIMULATOR_ERROR ("PRE_PROCESS EXCEPTION", UTILITY.FATAL);
      end PRE_PROCESS;

      function PRE_COMPARE (X, Y : in PRE_PROCESS_PTR) return boolean is
      begin
         return false;
      end PRE_COMPARE;

      package PREQ is new QUEUES ("PRE_PROQ", PRE_PROCESS_PTR, PRE_COMPARE);

-- declare PRE_Q in a little package
      package PREQL is
         PRE_Q : PREQ.QUEUE;
      end PREQL;
      use PREQL;

      function SIG_COMPARE (X, Y : in SYNCH_PTR) return boolean is
      begin
         return false;
      end SIG_COMPARE;

      package SIGQ is new QUEUES ("SIGNAL_Q", SYNCH_PTR, SIG_COMPARE);

-- declare SIG_Q in a little package
      package SIGQL is
         SIG_Q : SIGQ.QUEUE;
      end SIGQL;
      use SIGQL;

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

      package INTQ is new QUEUES ("INT_PROQ", INT_PROCESS_PTR, INT_COMPARE);

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


      procedure CREATE_PROCESS (PROCESS_REF : out PROCESS;
                                PROCESS_NAME : in string;
                                START_TIME, PRIORITY : in float;
                                PROCESS_ATTRIBUTES : in ATTRIBUTE_TYPE) is
         INTERNAL : INT_PROCESS_PTR;
         MASTER   : PRE_PROCESS_PTR;
         JOB_PTR  : PROCESS;
      begin
         if START_TIME < 0.0 then
            raise ACTIVATION_TIME_ERROR;
         end if;

-- first process in group sets up group record and queues
         if PGROUP = null then
            PGROUP := new GROUP_RECORD;
            PGROUP.GROUP_NAME := UTILITY.STRING_MATCH (PROCESS_GROUP_NAME, 8);
            GQ.INSERT_QUEUE (GROUP_Q, PGROUP);  
            INTQ.CREATE_QUEUE (INT_Q, PGROUP.GROUP_NAME);
            PREQ.CREATE_QUEUE (PRE_Q, PGROUP.GROUP_NAME);
            SIGQ.CREATE_QUEUE (SIG_Q, PGROUP.GROUP_NAME);
         end if;

         PROCESS_COUNTER := PROCESS_COUNTER + 1;

         -- Initialize process info. :
         JOB_PTR := new PROCESS_REC;
         JOB_PTR.NAME := UTILITY.STRING_MATCH (PROCESS_NAME, 8);
         JOB_PTR.STATUS := INACTIVE;
         JOB_PTR.ACTIVATION_TIME := START_TIME;
         JOB_PTR.PRIORITY := PRIORITY;
         JOB_PTR.GROUP_ID := PGROUP;
         JOB_PTR.PROCESS_ID := PROCESS_COUNTER;
         JOB_PTR.START_TIME := START_TIME;
         JOB_PTR.TERMINATION_TIME := 0.0;

-- Set up SYNCH task :
         if SIGQ.QUEUE_IS_EMPTY (SIG_Q) then
            JOB_PTR.SIGNAL := new SYNCH;
         else
            SIGQ.REMOVE_QUEUE_FIRST (SIG_Q, JOB_PTR.SIGNAL);
         end if;

         Q.INSERT_QUEUE (SIM_QUEUE, JOB_PTR);  -- event queue for scheduler
         PQ.INSERT_QUEUE (PROC_Q, JOB_PTR);    -- process queue for dump

         -- Set up task to spawn a process_kind job :
         if PREQ.QUEUE_IS_EMPTY (PRE_Q) then
            MASTER := new PRE_PROCESS;
         else
            PREQ.REMOVE_QUEUE_FIRST (PRE_Q, MASTER);
         end if;

-- save internal process info
         INTERNAL := new INT_PROCESS_REC;
         INTERNAL.PROCESS_ID := PROCESS_COUNTER;
         INTERNAL.ATTRIBUTE := PROCESS_ATTRIBUTES;
         INTERNAL.MASTER := MASTER;
         INTERNAL.SIGNAL := JOB_PTR.SIGNAL;
         INTQ.INSERT_QUEUE (INT_Q, INTERNAL);  

         PROCESS_REF := JOB_PTR;
         MASTER.START (NEW_JOB => JOB_PTR);

         if TRACE_OPT = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (SIM_TIME, CURRENT_PROCESS_NAME,
                                  "created process ", UTILITY.NO_LF);
            put (JOB_PTR.NAME); 
            put (" to start at ");
            put (START_TIME);
            new_line;
         end if;

      end CREATE_PROCESS;


      procedure GET_ATTRIBUTES (ATTRIBUTES : out ATTRIBUTE_TYPE) is
         INTERNAL : INT_PROCESS_PTR;
      begin
         if JOB = null then
            raise PROCESS_DOES_NOT_EXIST;
         end if;
         if TRACE_OPT = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (NUMBER => SIM_TIME, NAME => JOB.NAME,
               TEXT => "GET ATTRIBUTES", LF_FLAG => UTILITY.LF);
         end if;

         INTQ.FIRST_IN_QUEUE (INT_Q, INTERNAL);
         for I in 1 .. INTQ.LENGTH_OF_QUEUE (INT_Q) loop
           exit when INTERNAL.PROCESS_ID = JOB.PROCESS_ID;
           INTQ.NEXT_IN_QUEUE (INT_Q, INTERNAL);
         end loop;

         ATTRIBUTES := INTERNAL.ATTRIBUTE;
      end GET_ATTRIBUTES;


      procedure DESTROY_PROCESS is
         INTERNAL : INT_PROCESS_PTR;
      begin
         if JOB = null then
            raise PROCESS_DOES_NOT_EXIST;
         end if;
         if TRACE_OPT = UTILITY.ON then
            UTILITY.OUTPUT_TRACE (NUMBER => SIM_TIME, NAME => JOB.NAME,
               TEXT => "DESTROY PROCESS", LF_FLAG => UTILITY.LF);
         end if;

         INTQ.FIRST_IN_QUEUE (INT_Q, INTERNAL);
         for I in 1 .. INTQ.LENGTH_OF_QUEUE (INT_Q) loop
           exit when INTERNAL.PROCESS_ID = JOB.PROCESS_ID;
           INTQ.NEXT_IN_QUEUE (INT_Q, INTERNAL);
         end loop;
         INTQ.REMOVE_QUEUE_CURRENT (INT_Q);

         PREQ.INSERT_QUEUE (PRE_Q, INTERNAL.MASTER);   -- save PRE_PROCESS task
         SIGQ.INSERT_QUEUE (SIG_Q, INTERNAL.SIGNAL);   -- save SYNCH task
         FREE_INTERNAL (INTERNAL);
         TERMINATE_PROCESS;
      end DESTROY_PROCESS;

   end PROCESS_CREATOR;

begin  -- Simulation
   Q.CREATE_QUEUE (SIM_QUEUE, "EVENTS");
   PQ.CREATE_QUEUE (PROC_Q, "PROC_Q");
   GQ.CREATE_QUEUE (GROUP_Q, "GROUP_Q");
   Q.SET_QUEUE_REPORT_OPTION (UTILITY.OFF);
   PQ.SET_QUEUE_REPORT_OPTION (UTILITY.OFF);
   GQ.SET_QUEUE_REPORT_OPTION (UTILITY.OFF);
end SIMULATION;
