CDS LAB 6 2007 - BOUNDED BUFFERS & DINING PHILOSOPHERS BOUNDED BUFFERS =============== * Compile the above code and run it with 1 producer and 1.. --- The consumer underflows before the producer has put its numbers into the queue. We have a race condition. * Now increase the delay between the end of the loop that creates the.. --- It now works. The producer can now put numbers on to the queue faster than they can be taken off by the consumer. * Re-run the code but this time have multiple producers and consumers.. --- We can get garbage because in enqueue we must ensure that putting a data item and decrementing the queue pointer need to be an atomic operation, i.e. Queue.Elements (Queue.Free) := Item; Queue.Free := Marker'Pred (Queue.Free); or similarly for dequeue. If not two producers could put an item to the same queue.free, then queue.free jumps two values, .e.g.: TIME TASK1 TASK2 ------------------------------------------------------------------ 1 Queue.Elements (Queue.Free) := Item; 2 Queue.Elements (Queue.Free) := Item; 3 Queue.Free := Marker'Pred (Queue.Free); 4 Queue.Free := Marker'Pred (Queue.Free); i.e. queue.free effectively jumps an element and we are left with unassigned data in the queue. * Now modify the code to make it work properly! You should.. --- Stage 1 - as a protected object this will work if the producer can keep ahead of the last to finish consumer. The following code tends to work with multiple consumers and producers but fails with 1 and 1 In queue_pack_generic.ads, replace: procedure Enqueue (Item: in Element; Queue: in out Queue_Type); procedure Dequeue (Item: out Element; Queue: in out Queue_Type); with a protected type: protected type Queue_Operations is procedure Enqueue (Item: in Element); procedure Dequeue (Item: out Element); private Queue : Queue_Type; end Queue_Operations; Modify queue_pack_generic.adb as follows: package body Queue_Pack_Generic is protected body Queue_Operations is procedure Enqueue (Item: in Element) is begin -- as before, but comment out the delay 0.0 end Enqueue; Procedure Dequeue (Item: out Element) is begin -- as before, but comment out the delay 0.0 end Dequeue; end Queue_Operations; end Queue_Pack_Generic; In bounded_buffer_test.adb, replace the (separate) lines: The_Queue : Queue_Type; Dequeue(Item => My_Value, Queue => The_Queue); Enqueue (Item => i, Queue => The_Queue); respectively with their protected queue equivalents: The_Queue : Queue_Operations; The_Queue.Dequeue(Item => My_Value); The_Queue.Enqueue (Item => i); and remove the `delay 1.0' after the My_Producers'Range loop, as it is no longer needed). Stage 2 - the rest!! Note use of a smaller buffer size. In queue_pack_generic.ads, reduce QueueSize to 10, and define Enqueue/Dequeue now to be entry points protected type Queue_Operations is procedure Register; procedure Deregister; entry Enqueue (Item: in Element); entry Dequeue (Item: out Element); private Queue : Queue_Type; Active_Producers : Natural := 0; end Queue_Operations; and Queueoverflow/underflow are replaced with: No_Producers : exception; In queue_pack_generic.adb, Register/Deregister simply inc/decrement Active_Producers, and convert Enqueue/Dequeue to entry points. Enqueue can simply block the producer if the queue is full. We need only raise an exception on Dequeue if there are no active producers. with Ada.Text_IO; use Ada.Text_IO; package body Queue_Pack_Generic is protected body Queue_Operations is procedure Register is begin Active_Producers := Active_Producers + 1; end Register; procedure Deregister is begin Active_Producers := Active_Producers - 1; end Deregister; entry Enqueue (Item: in Element) when Queue.State /= Filled or Queue.Top /= Queue.Free is begin Queue.Elements (Queue.Free) := Item; Queue.Free := Marker'Pred (Queue.Free); Queue.State := Filled; end Enqueue; entry Dequeue (Item: out Element) when (Queue.State /= Empty) or (Queue.State = Empty and Active_Producers = 0) is begin if (Queue.State = Empty and Active_Producers = 0) then raise No_Producers; end if; Item := Queue.Elements (Queue.Top); Queue.Top := Marker'Pred(Queue.Top); if Queue.Top = Queue.Free then Queue.State := Empty; end if; end Dequeue; end Queue_Operations; end Queue_Pack_Generic; With bounded_buffer_test.adb, define an entry point which task type Consumer(Id : Integer) is entry Final_Value(Sub_Total : in out Natural); end Consumer; so that the exception clause of Consumer can add its total to an external variable passed into it: exception when No_Producers => begin Put("Consumer Terminates - Value"); Put (My_Total);New_Line; accept Final_Value(Sub_Total : in out Natural) do Sub_Total := Sub_Total + My_Total; end Final_Value; end; Also remove the `delay 0.01' from Consumer. The body of Producer is modified to register/deregister on entry exit: task body Producer is begin The_Queue.Register; ... -- rest same as for previous step, except remove the `delay 0.01' The_Queue.Deregister; end Producer; and the exception clause is no longer needed. Before the main Bounded_Buffer_Test task, add the declaration: Actual_Total : Natural := 0; Finally, before the end Bounded_Buffer_Test add the loop to collect the sums of the consumer tasks: for I in My_Consumers'Range loop My_Consumers(I).Final_Value(Actual_Total); end loop; Put("Actual Total is "); Put (Actual_Total);New_Line; ---------------------------------------------------------------------------- DINING PHILOSOPHERS =================== * The deadlock can be broken by ensuring that odd numbered philosophers.. this is very easy! if ( Integer(Ident) mod 2 = 0 ) then My_Fork_Controller.Get_Fork(Left); Put_Line("Philosopher" & Ident'Img & " has left fork"); delay Standard.Duration(Random(G)); My_Fork_Controller.Get_Fork(Right); Put_Line("Philosopher" & Ident'Img & " has both forks and is eating"); delay Standard.Duration(Random(G)); else My_Fork_Controller.Get_Fork(Right); Put_Line("Philosopher" & Ident'Img & " has right fork"); delay Standard.Duration(Random(G)); My_Fork_Controller.Get_Fork(Left); Put_Line("Philosopher" & Ident'Img & " has both forks and is eating"); delay Standard.Duration(Random(G)); end if; * restrict the number of philosophers permitted to sit at the table.. this is too easy also... Initialize a semaphore The_Table to Size-1: protected type Semaphore (Initial : Natural := 0) is entry Wait; -- P operation procedure Signal; -- V operation; private Value : Natural := Initial; end Semaphore; protected body Semaphore is entry Wait when Value > 0 is begin Value := Value - 1; end Wait; procedure Signal is begin Value := Value + 1; end Signal; end Semaphore; The_Table : Semaphore(Size-1); Then, in the philosopher task, do a: The_Table.Wait; just before the My_Fork_Controller.Get_Fork(Left); just after My_Fork_Controller.Release_Fork(Right), signal the semaphore: The_Table.Signal; ------------------------------------------------------------------------ * use a monitor like construct to control access to pairs of forks. Bit more tricky... We firstly need to have 3 values for fork availability ('2' means the philosopher has 2 forks available and can eat). type No_Philos is mod Size; type Availability is range 0..2; type Free_Fork_Array is array(No_Philos'Range) of Availability; We rename No_Forks to No_Philos for the sake of readability, as Free_Fork_Array reflects the number of forks available to each philosopher. Now Fork_Controller will have operations on pairs of forks: protected Type Fork_Controller is entry Get_2_Forks(No_Philos); procedure Release_2_Forks(ID : in No_Philos); function Deadlock return Boolean; private Free_Forks : Free_Fork_Array := (others => 2); end Fork_Controller; In the body of Fork_Controller, function Deadlock is modified so that if any of philosopher can get two forks it returns false: for I in No_Philos loop if Free_Forks(I) = 2 then Locked := False and we replace the code for Release_Fork and Get_Fork with Release_2_Forks and Get_2_Forks (which makes 1 fork unavailable for the left & right neighbors): procedure Release_2_Forks(ID : in No_Philos) is begin -- a fork Free_Forks(ID+1) := Free_Forks(ID+1) + 1; Free_Forks(ID-1) := Free_Forks(ID-1) + 1; end Release_2_Forks; entry Get_2_Forks(for ID in No_Philos) when Free_Forks(ID) = 2 is begin Free_Forks(ID+1) := Free_Forks(ID+1) - 1; Free_Forks(ID-1) := Free_Forks(ID-1) - 1; end Get_2_Forks; In the body of Philosopher, we have a simplified loop reflecting that forks are only acquired and released in pairs. loop Put_Line("Philosopher" & Ident'Img & " is thinking"); delay Standard.Duration(Random(G)); My_Fork_Controller.Get_2_Forks(Ident); Put_Line("Philosopher" & Ident'Img & " has both forks and is eating"); delay Standard.Duration(Random(G)); My_Fork_Controller.Release_2_Forks(Ident); end loop; ------------------------------------------------------------------------ * detect and break deadlock this is more tricky again. This following appears to work! From the original program, modify Fork_Controller to include a Release_Fork() fork entry: protected Type Fork_Controller is entry Get_Fork(No_Fork); entry Retrieve_Fork(No_Fork); procedure Release_Fork(Left_Or_Right : in No_Fork); procedure Deadlock(Return_Value : out Boolean); private The_Forks : Fork_Use := (others => AVAILABLE); Hung : Boolean := False; Retrieve : Boolean := False; end Fork_Controller; Note that Deadlock() is now a procedure as it sets Hung to true if a deadlock is detected: procedure Deadlock(Return_Value : out Boolean) is Locked : Boolean; begin ... -- same loop as before if Locked then Hung := True; end if; Return_Value := Locked; end Deadlock; and we define the entry family Retrieve_Fork to break the deadlock: entry Retrieve_Fork(for From in No_Fork) when The_Forks(From) = AVAILABLE and not Hung is I_Need_Fork : No_Fork; begin The_Forks(From) := IN_USE; I_Need_Fork := From + 1; requeue Get_Fork(I_Need_Fork); end Retrieve_Fork; Finally, the Get_Fork entry family is modified to allow entry when the system is hung, in which case it breaks the deadlock by taking the fork from the left neighbor (next time it is entered it resets the flags): entry Get_Fork(for From in No_Fork) when The_Forks(From) = AVAILABLE or Hung is I_have_Fork : No_Fork; begin if Hung and Retrieve then Hung := False; Retrieve := False; elsif Hung then I_Have_Fork := From - 1; The_Forks(I_Have_Fork) := AVAILABLE; Retrieve := True; requeue Retrieve_Fork(I_Have_Fork); end if; The_Forks(From) := IN_USE; end Get_Fork;