Author: Christian.Queinnec@lip6.fr

## Exercises

### The Philosophers Disentangled

To solve the possible deadlock of the dining philosophers, it suffices to limit access to the table to four at once. Implement this solution.
We add a counter indicating the number of philosophers present as well as two functions, `enter` and `leave`, tasked with limiting arrivals, and signalling departures, respectively.

    #

     let enter, leave =
       let n = ref 0 in
       let m = Mutex.create() in
       let c = Condition.create() in
       let loc_enter () =
         Mutex.lock m ;
         while not (!n < 4) do Condition.wait c m done ;
         incr n ;
         if !n > 1 then Printf.printf "%d philosophers are at the table\n" !n
         else Printf.printf "%d philosopher is at the table\n" !n ;
         flush stdout;
         Mutex.unlock m
       in
       let loc_leave () =
         Mutex.lock m ;
         decr n ;
         Mutex.unlock m ;
         Condition.broadcast c
       in
       loc_enter, loc_leave ;;
    val enter : unit -> unit = <fun>
    val leave : unit -> unit = <fun>

Then all that is necessary is to call these functions at the start and end of the loop of a philosopher.

    # let philosopher i =
       let ii = (i+1) mod 4 in
       while true do
         Printf.printf "Philosopher (%d) arrives\n" i ;
         enter () ;
         meditate 3. ;
         Mutex.lock b.(i);
         Printf.printf
     "Philosopher (%d) picks up his left-hand baguette and meditates a while longer\n" i;
         meditate 0.2; Mutex.lock b.(ii) ;
         Printf.printf "Philosopher (%d) picks up his right-hand baguette\n" i ;
         eat 0.5 ;
         Mutex.unlock b.(i) ;
         Printf.printf
     "Philosopher (%d) puts down his left-hand baguette and goes back to meditating\n" i;
         meditate 0.15 ;
         Mutex.unlock b.(ii) ;
         Printf.printf "Philosopher (%d) puts down his right-hand baguette" i ;
         leave () ;
         Printf.printf "Philosophe (%d) heads off \n" i ;
       done ;;
    val philosopher : int -> unit = <fun>

Attention, cette solution supprime les inter-blocages, mais pas les famines. Pour résoudre ce dernier problème, on peut soit se fier au hasard en introduisant un délai d'attente en aprés la sortie d'un philosophe, soit gérer explicitement une file d'attente.

### More of the Post Office

We suggest the following modification to the post office described on page ??: some impatient clients may leave before there number has been called.

1. Add a method `wait` (with type int -> unit) to the class `dispenser` which causes the caller to wait while the last number distributed is less than or equal to the parameter of the method (it is necessary to modify `take` so that it emits a signal).

       # class distrib () =
          object
            val mutable n = 0
            val m = Mutex.create ()
            val c = Condition.create ()

            method attendre nc =
              Mutex.lock m ;
              while (n <= nc) do Condition.wait c m done ;
              Mutex.unlock m

            method prendre () =
              Mutex.lock m ;
              n <- n+1 ;
             let nn = n in
             Condition.broadcast c ;
             Mutex.unlock m ;
             nn
          end ;;
       class distrib :
         unit ->
         object
           val c : Condition.t
           val m : Mutex.t
           val mutable n : int
           method attendre : int -> unit
           method prendre : unit -> int
         end

2. Modify the method `await_arrival` of class `counter`, so that it returns the boolean value `true` if the expected client arrives, and `false` if the client has not arrived at the end of a certain time.
   On rajoute une méthode privée `reveil` chargée de réveiller le guichetier en attente au bout d'un temps donné.

       #
          method private reveil t =
           let dt = delai_attente_appel /. 10.0 in
             while (Unix.gettimeofday() < t) do Thread.delay dt done;
             Condition.signal c

          method attendre_arrivee () =
           let t = Unix.gettimeofday() +. delai_attente_appel in
           let r = Thread.create self#reveil t in
             Mutex.lock m;
             while libre && (Unix.gettimeofday() < t) do
               Condition.wait c m
             done;
             (try Thread.kill r with _ -> ());
             let b = not libre in (Mutex.unlock m; b)

3. Modify the class `announcer` by passing it a number dispenser as a parameter and:
   1. adding a method `wait_until` which returns `true` if the expected number has been called during a given waiting period, and `false` otherwise;
      La modification de la méthode `appel` a pour but de garantir à la fois que ne sont appelés que des numéros effectivement distribués et que lorsqu'un numéro d'appel est affiché, il existe bien un guichet qui attend ce numéro.

          # class affich (d:distrib) =
             object
               val mutable nc = 0
               val m = Mutex.create ()
               val c = Condition.create ()

              method attendre n =
                Mutex.lock m ;
                while nc < n do Condition.wait c m done ;
                Mutex.unlock m

              method attendre_jusqu'a n t =
                Mutex.lock m ;
                while (nc < n) && (Unix.gettimeofday() < t) do Condition.wait c m done ;
                let b = not (nc < n) in
                Mutex.unlock m ;
                b

              method appel (g:guichet) =
                Mutex.lock m ;
                d#attendre nc ;
                nc <- nc+1 ;
                g#set_nc nc ;
                Condition.broadcast c ;
                Mutex.unlock m

             end ;;
          class affich :
            distrib ->
            object
              val c : Condition.t
              val m : Mutex.t
              val mutable nc : int
              method appel : guichet -> unit
              method attendre : int -> unit
              method attendre_jusqu'a : int -> float -> bool
            end

   2. modifying the method `call` to take a counter as parameter and update the field `nclient` of this counter (it is necessary to add an update method in the `counter` class).
4. Modify the function `clerk` to take fruitless waits into account.

       # type bureau = { d: distrib; a: affich; gs: guichet array }
       val delai_service : float = 4
       val delai_arrivee : float = 2
       val delai_guichet : float = 0.5
       val delai_attente_client : float = 0.7

        let guichetier ((a : affich), (g : guichet)) =
          while true do
            a#appel g ;
            Printf.printf"Guichet %d appelle %d\n" g#get_ng g#get_nc ;
            if g#attendre_arrivee () then g#attendre_depart ()
            else
              begin
                Printf.printf"Guichet %d n'attend plus %d\n" g#get_ng g#get_nc ;
                flush stdout
              end ;
            Thread.delay (Random.float delai_guichet)
          done ;;
       val guichetier : affich * guichet -> unit = <fun>

5. Write a function `impatient_client` which simulates the behaviour of an impatient client.

       # val chercher_guichet : 'a -> < get_nc : 'a; .. > array -> int = <fun>

        let client_impatient b =
          let n = b.d#prendre() in
          let t = Unix.gettimeofday() +. (Random.float delai_attente_client) in
          Printf.printf "Arrivee client impatient %d\n" n; flush stdout;
          if b.a#attendre_jusqu'a n t
          then
            let ig = chercher_guichet n b.gs in
            b.gs.(ig)#arriver() ;
            Printf.printf "Le client %d occupe le guichet %d\n" n ig ;
            flush stdout ;
            Thread.delay (Random.float delai_service) ;
            b.gs.(ig)#partir() ;
            Printf.printf "Le client %d s'en va\n" n
          else
            Printf.printf "Le client %d, las d'attendre, s'en va\n" n
          flush stdout ;;
       Characters 518-531:
       This function is applied to too many arguments

### Object Producers and Consumers

This exercise revisits the producer-consumer algorithm with the following variation: the storage warehouse is of finite size (i.e. a table rather than a list managed as a FIFO). Also, we propose to make an implementation that uses objects to model resources, like the post office.

1. Define a class `product` with signature:

       # class produit (s:string) =
        object
          val nom = s
          method nom = nom
        end ;;
       class produit : string -> object val nom : string method nom : string end

       class product : string ->
         object
           val name : string
           method name : string
         end

2. Define a class `shop` such that:

       # class magasin n =
          object(self)
            val mutable taille = n;
            val mutable np = 0
            val mutable buffer = ([||] : produit array)
            val mutable ip = 0  (* Indice producteur *)
            val mutable ic = 0  (* Indice consommateur *)

            val m = Mutex.create ()
            val c = Condition.create ()

            initializer buffer<-Array.create n (new produit "empty")

            method display1 () =
              let i = ip mod taille in
              Printf.printf "Ajout (%d)%s\n" i ((buffer.(i))#nom)

            method deposer p =
              Mutex.lock m ;
              while (ip-ic+1 > Array.length(buffer)) do Condition.wait c m done ;
              buffer.(ip mod taille) <- p ;
              self#display1() ;
              ip <- ip+1 ;
              Mutex.unlock m ;
              Condition.signal c

            method display2 () =
              let i = ic mod taille in
              Printf.printf "Retrait (%d)%s\n" i ((buffer.(i))#nom)

            method prendre () =
              Mutex.lock m ;
              while(ip == ic) do Condition.wait c m done ;
              self#display2() ;
              let r = buffer.(ic mod taille) in
              ic<- ic+1 ;
              Mutex.unlock m ;
              Condition.signal c ;
              r
          end ;;
       class magasin :
         int ->
         object
           val mutable buffer : produit array
           val c : Condition.t
           val mutable ic : int
           val mutable ip : int
           val m : Mutex.t
           val mutable np : int
           val mutable taille : int
           method deposer : produit -> unit
           method display1 : unit -> unit
           method display2 : unit -> unit
           method prendre : unit -> produit
         end

       class show : int ->
         object
           val mutable buffer : product array
           val c : Condition.t
           val mutable ic : int
           val mutable ip : int
           val m : Mutex.t
           val mutable np : int
           val size : int
           method dispose : product -> unit
           method acquire : unit -> product
         end

   The indexes `ic` and `ip` are manipulated by the producers and the consumers, respectively. The index `ic` holds the index of the last product taken and `ip` that of the last product stored. The counter `np` gives the number of products in stock. Mutual exclusion and control of the waiting of producers and consumers will be managed by the methods of this class.
3. Define a function `consumer`: shop`` ->`` string`` ->`` unit.

       # let consommateur mag na =
          while true do
            let p = mag#prendre() in
            Printf.printf "Le consommateur %s prend le produit %s\n" na p#nom ;
            flush stdout ;
            Thread.delay(Random.float(3.0))
          done ;;
       val consommateur :
         < prendre : unit -> < nom : string; .. >; .. > -> string -> unit = <fun>

4. Define a function `create_product` of type string -> product. The name given to a product will be composed of the string passed as an argument concatenated with a product number incremented at every invocation of the function.
   Use this function to define `producer`: shop`` ->`` string`` ->`` unit.

       # let producteur =
          let num = ref 0 in
          let creer_produit () =
            let p = new produit("lessive-"^(string_of_int !num)) in
            incr num ;
            p
          in
          function mag -> function nm ->
            while true do
              let p = creer_produit () in
              mag#deposer(p) ;
              Printf.printf"Production de %s\n" p#nom ;
              flush stdout ;
              Thread.delay (Random.float (1.0))
             done ;;
       val producteur : < deposer : produit -> '_a; _.. > -> '_b -> unit = <fun>