Multiprogrammed computer emulator with semaphores

Use mocaml as in previous post.

  ./semaphore.ml <file>

This file should be available at:

   http://www.cs.uvm.edu/~dvanhorn/ocaml/os/semaphore.ml

-d

----semaphore.ml----

#!/home/cs/csugrads/dvanhorn/local/bin/mocaml

(**
   Multiprogrammed computer emulator with semaphores

   Copyright (c) 2003 David Van Horn
   Licensed under the Academic Free License version 2.0

   A work of art is a machine with an aesthetic purpose.
   -- James Boyk

   This program simulates the events in a multiprogrammed computer according
   to the following guidelines: Semaphores are used as synchronization
   primitives. The number of semaphores and processes are unbounded. The wait
   and signal operations on the semaphores are atomic.  Scheduling is
   non-preemptive First-Come-First-Served (FCFS).  A process continues to
   execute until a wait operation causes it to sleep on a semaphore.  The
   semaphore implementation associates a list of waiting processes for each
   semaphore (See page 203 of the textbook (6th Ed)).  A counter implements a
   logical clock.  At each increment of the counter the program checks if the
   current counter value (time) matches with an arrival time of any process,
   and enter arriving process(es) automatically into the tail of the ready
   queue.  If a process finishes completely then it leaves the system, and the
   process at the head of the ready queue is allocated the CPU.  A process
   issuing a wait on a semaphore is blocked, and a process at the head of the
   ready queue is allocated the CPU. NB The system remembers the next
   instruction in the process as the point to resume when the process is woken
   up at a later time.

   Simulation continues until all processes finish completely.  Semaphores are
   defined and initialized by a statement of the following format:

   SEM <semaphore number> <initial value>

   An input file includes information for all processes, their arrival times,
   CPU-bursts, wait and signal on semaphores.  Input lines are of six possible
   formats:

   SEM <semaphore number> <initial value>
   BEGIN <process number (<=10)> <arrival time>
   CPU <CPU burst>
   WAIT <semaphore number>
   SIGNAL <semaphore number>
   END /* Process description ends */

   The following is an example:

   SEM 1 0

   BEGIN 1 0
   WAIT 1
   CPU 7
   END

   BEGIN 2 5
   CPU 4
   SIGNAL 1
   END

   The program reports which process executes as there occurs a change.
   Events are reported in the following format (output for above inputs):

   TIME: 0 PRO 1 EXEC
   TIME: 5 PRO 2 EXEC
   TIME: 9 PRO 1 EXEC

   @author David Van Horn
*)

module Semaphore =
  struct
    open List
    open Printf
    open Str

    (**
       An instruction is either a cpu burst, a wait, or a signal.  A wait or
       signal give a semaphore id.
    *)
    type instruction =
      | Burst of int
      | Signal of int
      | Wait of int
	
    (**
       A process is either the NullProcess or consists of a process number, an
       arrival time, and a list of instructions.
    *)
    type process =
      | Process of int * int * instruction list
      | NullProcess
	
    (**
       A semaphore is constituted by a semaphore number (id), a current value,
       and a list of processes.
    *)
    type semaphore = Semaphore of int * int * process list

    let arrive_now_p t = function
      | Process(_,a,_) when a=t -> true
      | _ -> false
	
    let print_event t p =
      printf "TIME %d PRO %d EXEC\n" t (match p with Process(n,_,_) -> n)

    (**
       The step function transitions from machine configuration to machine
       configuration.  A machine configuration is a 5-tuple consisting of a
       queue of processes that have arrived and are waiting to be swapped into
       the cpu, a process that is currently running on the cpu, the current
       time, a list of semaphores, and a list of process that have yet to
       arrive.
    *)
    let step (q,p,t,s,j) =

      (*
	 We push all processes that are scheduled to arrive at the current
	 time onto the queue.
      *)
      let q = append q (filter (arrive_now_p t) j) in

      (*
	 We remove from the list of processes that have yet to arrive those
	 processes which are scheduled to arrive at the current time.
      *)
      let j = filter (fun x -> (not (arrive_now_p t x))) j in

      match (q,p,t,s) with
      (*
	 If the queue is empty and the null process is currently executing
         (the cpu is idle), we have nothing to do, so increment the time and
         continue.
      *)
      | [], NullProcess, t, s -> [], NullProcess, t+1, s, j

      (*
	 If the queue is non-empty and the null process is currently executing
	 (the cpu is idle), we take the next process from the queue and swap
	 it into the cpu.  This operation does not increment the time.
      *)
      | p::q, NullProcess, t, s ->
	  print_event t p;
	  q, p, t, s, j

      (*
	 If the currently executing process has exhausted its instructions,
         the cpu becomes idle. This operation does not increment the time.
      *)
      | q, Process(n,a,[]), t, s -> q, NullProcess, t, s, j

      (*
	 If the current process issues a wait, when the signaled semaphore has
	 a value less than zero, then the value is decremented and the current
	 process is removed from the cpu and placed in the semaphore.
	 Otherwise the current value is decremented and the process continues
	 to run.
      *)
      | q, Process(n,a,Wait(i)::is), t, s ->
	  let ([sem],s') =
	    partition
	      (function
		| Semaphore(id,_,_) when id = i -> true
		| _ -> false)
	      s
	  in
	  (match sem with
	  |	Semaphore(id,v,ps) when v-1 < 0 ->
	      q, NullProcess, t, Semaphore(id,v-1,Process(n,a,is)::ps)::s', j
	  | Semaphore(id,v,ps) ->
	      q, Process(n,a,is), t, Semaphore(id,v-1,ps)::s', j)
	
      (*
	If the current process issues a signal, when the signaled semaphore
        has a value less than or equal to zero, then the next process in the
        semaphore is placed in the ready queue, the value is incremented and
        the current process continues running.  If the signaled semaphore has
        a positive value, the value and time are incremented and the current
        process continues running.
      *)
      | q, Process(n,a,Signal(i)::is), t, s ->
	  let ([sem],s') =
	    partition
	      (function
		| Semaphore(id,_,_) when id = i -> true
		| _ -> false)
	      s
	  in
	  (match sem with
	  |	Semaphore(id,v,p::ps) when v+1 <= 0 ->
	      q@[p], Process(n,a,is), t, Semaphore(id,v+1,ps)::s', j
	  | Semaphore(id,v,ps) ->
	      q, Process(n,a,is), t, Semaphore(id,v+1,ps)::s', j)
	
      (*
	 If the current process has no burst time remaining, we go to the next
         instruction.  This operation does not increment the time.
      *)
      | q, Process(n,a,Burst(0)::is), t, s -> q, Process(n,a,is), t, s, j

      (*
	If the current process has burst time remaining, we let the cpu
        continue to run the process, decrementing the burst and incrementing
        the time.
      *)
      | q, Process(n,a,Burst(i)::is), t, s ->
	  q, Process(n,a,Burst(i-1)::is), t+1, s, j

    let parse file_name =
      let in_channel = (open_in file_name) in
      let rec loop (ss, ps) =
	try
	  match (split (regexp "[ \t]+") (input_line in_channel)) with
	  | ["SEM"; n; i] ->
	      loop (Semaphore(int_of_string n, int_of_string i, [])::ss, ps)
	  | ["BEGIN"; n; a] ->
	      let instrs =
		let rec lp ins =
		  match (split (regexp "[ \t]+") (input_line in_channel)) with
		  | ["CPU"; b] -> lp ((Burst (int_of_string b))::ins)
		  | ["SIGNAL"; i] -> lp ((Signal (int_of_string i))::ins)
		  | ["WAIT"; i] -> lp ((Wait (int_of_string i))::ins)
		  | ["END"] -> rev ins
		in lp []
	      in
	      loop (ss, Process(int_of_string n, int_of_string a, instrs)::ps)
	  | _ -> loop (ss, ps)
	with End_of_file -> (ss, ps)
      in
      loop ([], [])

    (**
       A machine runs until it is in a final configuration, which is defined
       as a configuration with no processes in the waiting queue, an idle cpu,
       and no processes yet to arrive.
    *)	
    let main file_name =
      let rec loop = function
	| [], NullProcess, _, _, [] -> ()
	| state -> loop (step state)
      in
      let (sem_list, proc_list) = parse file_name in
      loop ([], NullProcess, 0, sem_list, proc_list)

  end
;;

Semaphore.main(Sys.argv.(1));;