Then all that is necessary is to call these functions at the start and end of the loop of a philosopher.
#letenter,leave=letn=ref0inletm=Mutex.create()inletc=Condition.create()inletloc_enter()=Mutex.lockm;whilenot(!n<4)doCondition.waitcmdone;incrn;if!n>1thenPrintf.printf"%d philosophers are at the table\n"!nelsePrintf.printf"%d philosopher is at the table\n"!n;flushstdout;Mutex.unlockminletloc_leave()=Mutex.lockm;decrn;Mutex.unlockm;Condition.broadcastcinloc_enter,loc_leave;;val enter : unit -> unit = <fun>val leave : unit -> 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.
# letphilosopheri=letii=(i+1)mod4inwhiletruedoPrintf.printf"Philosopher (%d) arrives\n"i;enter();meditate3.;Mutex.lockb.(i);Printf.printf"Philosopher (%d) picks up his left-hand baguette and meditates a while longer\n"i;meditate0.2;Mutex.lockb.(ii);Printf.printf"Philosopher (%d) picks up his right-hand baguette\n"i;eat0.5;Mutex.unlockb.(i);Printf.printf"Philosopher (%d) puts down his left-hand baguette and goes back to meditating\n"i;meditate0.15;Mutex.unlockb.(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>
# classdistrib()=objectvalmutablen=0valm=Mutex.create()valc=Condition.create()methodattendrenc=Mutex.lockm;while(n<=nc)doCondition.waitcmdone;Mutex.unlockmmethodprendre()=Mutex.lockm;n<-n+1;letnn=ninCondition.broadcastc;Mutex.unlockm;nnend;;class distrib :unit ->objectval c : Condition.tval m : Mutex.tval mutable n : intmethod attendre : int -> unitmethod prendre : unit -> intend
#methodprivatereveilt=letdt=delai_attente_appel/.10.0inwhile(Unix.gettimeofday()<t)doThread.delaydtdone;Condition.signalcmethodattendre_arrivee()=lett=Unix.gettimeofday()+.delai_attente_appelinletr=Thread.createself#reveiltinMutex.lockm;whilelibre&&(Unix.gettimeofday()<t)doCondition.waitcmdone;(tryThread.killrwith_->());letb=notlibrein(Mutex.unlockm;b)
# classaffich(d:distrib)=objectvalmutablenc=0valm=Mutex.create()valc=Condition.create()methodattendren=Mutex.lockm;whilenc<ndoCondition.waitcmdone;Mutex.unlockmmethodattendre_jusqu'ant=Mutex.lockm;while(nc<n)&&(Unix.gettimeofday()<t)doCondition.waitcmdone;letb=not(nc<n)inMutex.unlockm;bmethodappel(g:guichet)=Mutex.lockm;d#attendrenc;nc<-nc+1;g#set_ncnc;Condition.broadcastc;Mutex.unlockmend;;class affich :distrib ->objectval c : Condition.tval m : Mutex.tval mutable nc : intmethod appel : guichet -> unitmethod attendre : int -> unitmethod attendre_jusqu'a : int -> float -> boolend
#type bureau = { d: distrib; a: affich; gs: guichet array }val delai_service : float = 4val delai_arrivee : float = 2val delai_guichet : float = 0.5val delai_attente_client : float = 0.7letguichetier((a:affich),(g:guichet))=whiletruedoa#appelg;Printf.printf"Guichet %d appelle %d\n"g#get_ngg#get_nc;ifg#attendre_arrivee()theng#attendre_depart()elsebeginPrintf.printf"Guichet %d n'attend plus %d\n"g#get_ngg#get_nc;flushstdoutend;Thread.delay(Random.floatdelai_guichet)done;;val guichetier : affich * guichet -> unit = <fun>
#val chercher_guichet : 'a -> < get_nc : 'a; .. > array -> int = <fun>letclient_impatientb=letn=b.d#prendre()inlett=Unix.gettimeofday()+.(Random.floatdelai_attente_client)inPrintf.printf"Arrivee client impatient %d\n"n;flushstdout;ifb.a#attendre_jusqu'antthenletig=chercher_guichetnb.gsinb.gs.(ig)#arriver();Printf.printf"Le client %d occupe le guichet %d\n"nig;flushstdout;Thread.delay(Random.floatdelai_service);b.gs.(ig)#partir();Printf.printf"Le client %d s'en va\n"nelsePrintf.printf"Le client %d, las d'attendre, s'en va\n"nflushstdout;;Characters 518-531:This function is applied to too many arguments
# classproduit(s:string)=objectvalnom=smethodnom=nomend;;class produit : string -> object val nom : string method nom : string end
classproduct:string->objectvalname:stringmethodname:stringend
# classmagasinn=object(self)valmutabletaille=n;valmutablenp=0valmutablebuffer=([||]:produitarray)valmutableip=0(* Indice producteur *)valmutableic=0(* Indice consommateur *)valm=Mutex.create()valc=Condition.create()initializerbuffer<-Array.createn(newproduit"empty")methoddisplay1()=leti=ipmodtailleinPrintf.printf"Ajout (%d)%s\n"i((buffer.(i))#nom)methoddeposerp=Mutex.lockm;while(ip-ic+1>Array.length(buffer))doCondition.waitcmdone;buffer.(ipmodtaille)<-p;self#display1();ip<-ip+1;Mutex.unlockm;Condition.signalcmethoddisplay2()=leti=icmodtailleinPrintf.printf"Retrait (%d)%s\n"i((buffer.(i))#nom)methodprendre()=Mutex.lockm;while(ip==ic)doCondition.waitcmdone;self#display2();letr=buffer.(icmodtaille)inic<-ic+1;Mutex.unlockm;Condition.signalc;rend;;class magasin :int ->objectval mutable buffer : produit arrayval c : Condition.tval mutable ic : intval mutable ip : intval m : Mutex.tval mutable np : intval mutable taille : intmethod deposer : produit -> unitmethod display1 : unit -> unitmethod display2 : unit -> unitmethod prendre : unit -> produitend
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.
classshow:int->objectvalmutablebuffer:productarrayvalc:Condition.tvalmutableic:intvalmutableip:intvalm:Mutex.tvalmutablenp:intvalsize:intmethoddispose:product->unitmethodacquire:unit->productend
-> string -> unit.
# letconsommateurmagna=whiletruedoletp=mag#prendre()inPrintf.printf"Le consommateur %s prend le produit %s\n"nap#nom;flushstdout;Thread.delay(Random.float(3.0))done;;val consommateur :< prendre : unit -> < nom : string; .. >; .. > -> string -> unit = <fun>
-> string -> unit.
# letproducteur=letnum=ref0inletcreer_produit()=letp=newproduit("lessive-"^(string_of_int!num))inincrnum;pinfunctionmag->functionnm->whiletruedoletp=creer_produit()inmag#deposer(p);Printf.printf"Production de %s\n"p#nom;flushstdout;Thread.delay(Random.float(1.0))done;;val producteur : < deposer : produit -> '_a; _.. > -> '_b -> unit = <fun>