Exercises

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.

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

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)

Modify the class announcer by passing it a number dispenser as a parameter and:

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

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).

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>

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.

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

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.

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>

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>