No, not really. In case Dijkstra's original problem was too easy to code, or you'd like a larger multithreaded programming challenge, we offer a little extension. It's written to make use of all kinds of communication paradigms: asynchronous calls, blocking calls, balking calls, and calls with timeouts.
A restaurant has a dining room with a single round table with five seats and only one chopstick between each setting. The restaurant employs two waiters (Miria and Isaac) and three chefs (Eren, Mikasa, and Armin), and serves six different meals which are:
Paella $13.25 Wu Hsiang Chi $10.00 Bogrács Gulyás $11.25 Spanokopita $6.50 Moui Nagden $12.95 Sambal Goreng Udang $14.95
Each of the entrees comes with an optional soup (which is always Albóndigas, for $3.00) and an optional desert (Berog, for $3.50).
The restaurant's entire clientèle is made up of five philosophers who spend their lives coming in to the restaurant, thinking, eating, and then leaving. They insist on eating everything, even the Albóndigas soup, with two chopsticks, in the manner described by Dijkstra in the original Dining Philosophers Problem. Each philosopher begins life with a certain amount of money (perhaps $200) and leaves when unable to afford another meal.
When a philosopher enters the dining room, they are seated at an available seat, thinks for a short amount of time, and places an order to an available waiter. The waiter takes the order to the kitchen and hand delivers it to a chef who will then prepare the meal (cooking takes a fair amount of time). When a chef finishes the meal, they place it on the counter (this should be a FIFO queue, lest some orders rot) where a waiter will pick it up and deliver it to the philosopher who ordered it.
After eating (which takes some amount of time), the philosopher pays for their meal and leaves the restaurant. If they cannot afford the meal that they ordered, they leave for good; otherwise they will return at some later time. When all the philosophers have left for good, the restaurant closes down.
If a philosopher does not get their order placed within a certain amount of time they will leave for a bit. If a waiter cannot immediately place an order with a chef (because all chefs are busy, say) he gives the philosopher a coupon good for $5.00 and the philosopher leaves the restaurant. Chefs take a hookah break after every fourth meal they prepare.
The problem is to program a proper functioning of the restaurant system. There must of course be absence of deadlock and starvation; furthermore, a waiter must not deliver an order to the wrong customer, etc. One solution makes the table a protected resource which only allows four philosophers to be seated at any one time. Another alternative has one of the philosophers pick up chopsticks in the opposite order from the others.
Implementations can be animated with cool graphics, or employ a simple log. Examples of log messages (in English) are:
The restaurant is now open for business. Philosopher Susan Haack is being seated in chair 4. Philosopher Zhaozhou has ordered Bogrács Gulyás from waiter Miria. Chef Eren is cooking the Spanokopita for Philosopher Russell. Philosopher David Hume has paid $17.95 and left the restaurant. Waiter TwiddleDee is serving philosopher Omar Khayyám Paella and Berog. Philosopher Kaṇāda has left the restaurant without being served. Chef Mikasa has returned from a hookah break. The restaurant has closed down.
This problem is just about the right size to cover a fair amount of Ada: we can employ packages, tasks and protected objects, some generics, exceptions, and some cool synchronization objects. Our solution will employ a host, named Ryuk, who makes sure that the table always has at least one seat. He also gets notified whenever a philosopher leaves for good, and when all philosophers are gone, he fires the cooks, who then quit for good. Then Ryuk quits. When the waiters see that Ryuk has quit, they quit too. All the other objects—the chopsticks, heat lamps, and synchronization objects—are all passive, so the whole simulation shuts down cleanly and beautifully.
Let's start with a logger.
We make a logger to ensure that different threads don't interleave their messages. We'll wrap this in a package called Reporter:
------------------------------------------------------------------------------
-- reporter.ads
--
-- A plain package for serializing the output of messages to standard output.
------------------------------------------------------------------------------
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;
package Reporter is
procedure Report (Message: String);
procedure Report (Message: Unbounded_String);
end Reporter;
------------------------------------------------------------------------------
-- reporter.adb
--
-- Implementation of the Reporter package.
------------------------------------------------------------------------------
with Ada.Text_IO;
use Ada.Text_IO;
package body Reporter is
protected Output is
procedure Send (Message: String);
end Output;
protected body Output is
procedure Send (Message: String) is
begin
Put_Line (Message);
end Send;
end Output;
procedure Report (Message: String) is
begin
Output.Send (Message);
end Report;
procedure Report (Message: Unbounded_String) is
begin
Output.Send (To_String(Message));
end Report;
end Reporter;
As far as I know, Ada doesn't have a nice built-in blocking queue like Java does. So, hey, let's write one! It isn't hard. It's so formulaic there's a chance I wrote this exactly like someone else did.
------------------------------------------------------------------------------
-- buffers.ads
--
-- A generic package for bounded, blocking FIFO queues (buffers). It exports
-- a proected type called 'Buffer'. Note that the maximum size of any buffer
-- of this type is taken from a single generic package parameter.
--
-- Generic Parameters:
--
-- Item the desired type of the buffer elements.
-- Size the maximum size of a buffer of type Buffer.
--
-- Entries:
--
-- Write (I) write item I to the buffer.
-- Read (I) read into item I from the buffer.
------------------------------------------------------------------------------
generic
type Item is private;
Size: Positive;
package Buffers is
subtype Index is Integer range 0..Size-1;
type Item_Array is array (Index) of Item;
protected type Buffer is
entry Write (I: Item);
entry Read (I: out Item);
private
Data : Item_Array;
Front : Index := 0; -- index of head (when not empty)
Back : Index := 0; -- index of next free slot
Count : Integer range 0..Size := 0; -- number of items currently in
end Buffer;
end Buffers;
------------------------------------------------------------------------------
-- buffers.adb
--
-- Implementation of the Buffers package.
------------------------------------------------------------------------------
package body Buffers is
protected body Buffer is
entry Read (I: out Item) when Count > 0 is
begin
I := Data(Front); -- copy the element out
Front := (Front + 1) mod Size; -- position Front to new front
Count := Count - 1; -- note that now one less item
end Read;
entry Write (I: Item) when Count < Size is
begin
Data(Back) := I; -- insert into buffer storage
Back := (Back + 1) mod Size; -- next item will go here
Count := Count + 1; -- note that now one more item
end Write;
end Buffer;
end Buffers;
I figured I go with a library to isolate some of the special random facilities I needed, like generating a random value from an enumeration type. Here's what I came up with:
------------------------------------------------------------------------------
-- randoms.ads
--
-- A package for simple random number generation. Ada provides powerful and
-- sophisticated random number facilities which are a bit heavy handed for
-- simple applications. This package provides only the basics. Conceptually
-- it implements a single random number generator, from which you can obtain
-- random discretes and floats. The operations are:
--
-- Reset reset the generator to some unspecified state.
-- Reset (Seed) reset the generator to the state specified by Seed.
-- Random (X, Y) return a random number in X..Y inclusive. There are
-- integer and floating point versions of this function.
-- Random_Discrete a generic function to return a random value from a giv-
-- en discrete type.
------------------------------------------------------------------------------
package Randoms is
procedure Reset;
procedure Reset (Seed: Integer);
function Random (X, Y: Integer) return Integer;
function Random (X, Y: Float) return Float;
generic type Element is (<>); function Random_Discrete return Element;
end Randoms;
------------------------------------------------------------------------------
-- randoms.adb
--
-- Body for the simple random number generation package. The implementation
-- uses a single private random number generator for floats; this generator is
-- called to obtain both integers and floats by using appropriate scaling.
------------------------------------------------------------------------------
with Ada.Numerics.Float_Random;
use Ada.Numerics.Float_Random;
package body Randoms is
G: Generator;
procedure Reset is
begin
Reset (G);
end Reset;
procedure Reset (Seed: Integer) is
begin
Reset (G, Seed);
end Reset;
-- To generate a random float in X .. Y inclusive we first use the built-in
-- generator to get a value R in 0.0 .. 1.0. Mapping R into the range
-- X .. Y is done essentially by computing X+R*(Y-X), however the compu-
-- tation Y-X may overflow for very large Y and very small X. So we
-- distribute the multiplication, and order terms in such a way as to
-- avoid overflow.
function Random (X, Y: Float) return Float is
R: Float := Random(G);
begin
return X - X*R + Y*R;
end Random;
-- Obtaining a random integer in a given range is a little tricky. We
-- start by obtaining a random float R such that 0.0 <= R < 1.0.
-- We essentially partition the range [0.0, 1.0> into Y-X+1 equal
-- subranges so that each subrange corresponds to an integer in X..Y
-- inclusive. To map the random float into the right integer we compute
-- Floor(X+R*(Y-X+1)). Note the importance of the open upper bound!
-- Of course we have to guard against overflow and maximize precision
-- of the floating point computations by ordering the terms in a nice
-- manner.
function Random (X, Y: Integer) return Integer is
R: Float := Random(G);
begin
while R = 1.0 loop
R := Random(G);
end loop;
return Integer(Float'Floor(Float(X) - Float(X)*R + Float(Y)*R + R));
end Random;
-- Random values in a discrete range are easy to generate; we just get a
-- random integer and convert the type.
function Random_Discrete return Element is
Min: Integer := Element'Pos(Element'First);
Max: Integer := Element'Pos(Element'Last);
begin
return Element'Val(Random(Min, Max));
end Random_Discrete;
begin
Reset (G);
end Randoms;
Count down latches are cool. Yeah, Java's got that class built in to its standard library. It only takes like 45 lines of commented code to write one in Ada, so here goes!
------------------------------------------------------------------------------
-- protected_counters.ads
--
-- This package defines protected type Counter. A counter is basically an in-
-- teger which starts with some initial positive value and is decremented (by
-- 1) by calling tasks. When a task decrements the counter it is informed
-- whether or not it made the counter go to zero. The decrement and test
-- are bound together in a critical section because without this protection,
-- the zero might be missed or discovered by two different tasks!
--
-- Entries:
--
-- Decrement_And_Test_If_Zero (Is_Zero) decrements the counter's value and
-- sets Is_Zero to whether the newly
-- updated value is 0.
------------------------------------------------------------------------------
package Protected_Counters is
protected type Counter (Initial_Value: Positive) is
procedure Decrement_And_Test_If_Zero (Is_Zero: out Boolean);
private
Value: Natural := Initial_Value;
end Counter;
end Protected_Counters;
------------------------------------------------------------------------------
-- protected_counters.adb
--
-- Implementation of the protected counter.
------------------------------------------------------------------------------
package body Protected_Counters is
protected body Counter is
procedure Decrement_And_Test_If_Zero (Is_Zero: out Boolean) is
begin
Value := Value - 1;
Is_Zero := Value = 0;
end Decrement_And_Test_If_Zero;
end Counter;
end Protected_Counters;
Can it be we haven't written any application code yet! Geez! Well let's start with a little package that gives nice names to the simulation objects. Note the cute little trick that enforces the number of chopsticks equals the number of philosophers.
------------------------------------------------------------------------------
-- names.ads
--
-- This package defines a collection of enumerated types that name some of the
-- objects in the simulation: namely the philosophers, chopsticks, waiters,
-- and cooks.
--
-- Note that we enforce the rule that there have to be the same number of
-- chopsticks as philosophers.
--
-- Note also that names are not given to the host, order bin, heat lamp, or
-- reporter since these are essentially unique objects.
------------------------------------------------------------------------------
package Names is
type Philosopher_Name is (Kaṇāda, Zhaozhou, David_Hume, Susan_Haack, Omar_Khayyám);
type Chopstick_Name is range 0..Philosopher_Name'Pos(Philosopher_Name'Last);
type Waiter_Name is (Miria, Isaac);
type Cook_Name is (Moe, Larry, Curly);
end Names;
It's a good idea to drop the meals our philosophers are going to be stuffing themselves with into a nice package of their own.
------------------------------------------------------------------------------
-- meals.ads
--
-- A package containing the public data type Meal. A meal consists of an en-
-- tree, an optional soup, and an optional dessert. Three meal operations are
-- provided:
--
-- Random_Meal A random meal.
-- Price (M) The price of meal M.
-- S & M concatentates unbounded string S and text of M.
------------------------------------------------------------------------------
with Randoms, Ada.Strings.Unbounded;
use Randoms, Ada.Strings.Unbounded;
package Meals is
type Entree_Selection is (
Paella,
Wu_Hsiang_Chi,
Bogracs_Gulyas,
Spanokopita,
Moui_Nagden,
Sambal_Goreng_Udang
);
type Soup_Selection is (
No_Soup,
Albondigas
);
type Dessert_Selection is (
No_Dessert,
Berog
);
type Meal is record
Entree : Entree_Selection;
Soup : Soup_Selection;
Dessert : Dessert_Selection;
end record;
function Random_Meal return Meal;
function Price (M: Meal) return Float;
function "&" (S: Unbounded_String; M: Meal) return Unbounded_String;
end Meals;
------------------------------------------------------------------------------
-- meals.adb
--
-- Implementation of the Meals package.
------------------------------------------------------------------------------
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;
package body Meals is
-- Store the prices of each individual meal component in tables for
-- efficient lookup.
E_Price: constant array (Entree_Selection) of Float := (
13.25, 10.00, 11.25, 6.50, 12.95, 14.95
);
S_Price: constant array (Soup_Selection) of Float := (0.00, 3.00);
D_Price: constant array (Dessert_Selection) of Float := (0.00, 3.50);
-- The price of a meal is found simply by looking up the prices of each of
-- the three components of the meal in the price tables and adding them up.
function Price (M: Meal) return Float is
begin
return E_Price(M.Entree) + S_Price(M.Soup) + D_Price(M.Dessert);
end Price;
-- To compute a random meal we pick a random entree selection, a random
-- soup selection, and a random dessert selection. Generators for
-- random selections are constructed by instantiating the generic
-- function Random_Discrete.
function Random_Entree is new Random_Discrete (Entree_Selection);
function Random_Soup is new Random_Discrete (Soup_Selection);
function Random_Dessert is new Random_Discrete (Dessert_Selection);
function Random_Meal return Meal is
begin
return (Random_Entree, Random_Soup, Random_Dessert);
end Random_Meal;
-- This is the function which gives the text describing a meal. The
-- string takes one of four forms, depending on the presence/abscence
-- of soup and dessert:
--
-- 1. <entree>
-- 2. <entree> with <soup>
-- 3. <entree> with <dessert>
-- 4. <entree> with <soup> and <dessert>
function "&" (S: Unbounded_String; M: Meal) return Unbounded_String is
Result: Unbounded_String := S;
begin
Append (Result, Entree_Selection'Image(M.Entree));
if M.Soup /= No_Soup or else M.Dessert /= No_Dessert then
Append (Result, " WITH ");
if M.Soup /= No_Soup then
Append (Result, Soup_Selection'Image(M.Soup));
if M.Dessert /= No_Dessert then
Append (Result, " AND ");
end if;
end if;
if M.Dessert /= No_Dessert then
Append (Result, Dessert_Selection'Image(M.Dessert));
end if;
end if;
return Result;
end "&";
end Meals;
Philosophers are going to place orders with waiters who will give them to cooks to prepare. After cooks finish cooking an order, they will put the meal in a queue for waiters to fetch and give to a philosopher. This queue is called the heat lamp. At any rate here is a package that defines these entities:
------------------------------------------------------------------------------
-- orders.ads
--
-- This package contains the public data type Order and a heat lamp to store
-- finished orders under.
--
-- Types:
--
-- Order An order is simply a pair consisting of a meal and the
-- philosopher who ordered it.
--
-- Objects:
--
-- Heat_Lamp When cooks are finished preparing an order they place it
-- under this heat lamp. A waiter should come by and pick it up
-- and take it to the table. This object is represented as a
-- bounded blocking queue with a capacity of five orders.
------------------------------------------------------------------------------
with Names, Meals, Buffers;
use Names, Meals;
package Orders is
type Order is record
Diner : Philosopher_Name; -- Who ordered it
Food : Meal; -- What they ordered
end record;
-- The order bin and the heat lamp are simply queues of orders, so first
-- instantiate the generic package for blocking queues:
package Order_Buffers is new Buffers (Order, 5);
use Order_Buffers;
-- Now declare the buffer objects:
Heat_Lamp : Buffer;
end Orders;
Cooks will be our first active simulation type; we represent them with Ada tasks. Cooks lead an interesting life. They take a lot of breaks, and eventually get fired. Here's a package for them.
------------------------------------------------------------------------------
-- cooks.ads
--
-- This package supplies a task type for the Cooks in the Enhanced Dining
-- Philosophers simulation. It also defines an array of cooks.
--
-- Entries:
--
-- Here_Is_Your_Name (Name) assigns the name Name to the cook.
-- Prepare (O) call this to tell the cook to prepare order O.
-- The cook simply takes the order and lets the
-- calling task resume immediately (the caller
-- does not have to wait while the cook cooks.
-- Pink_Slip "fires" the cook (terminating the task).
--
-- Behavior:
--
-- First the cook waits for a name, then reports to work. After that, she
-- repeatedly: receives an order (from a waiter), cooks it, then puts it un-
-- der the heat lamp. After every fourth meal, she goes on a coffee break.
-- While waiting for an order from a waiter, she might get a pink slip.
--
-- Termination:
--
-- A cook is explicitly "fired" by the Host before the host dies.
------------------------------------------------------------------------------
with Names, Orders;
use Names, Orders;
package Cooks is
task type Cook is
entry Here_Is_Your_Name (Name: Cook_Name);
entry Prepare (O: Order);
entry Pink_Slip;
end Cook;
Cook_Array: array (Cook_Name) of Cook;
end Cooks;
------------------------------------------------------------------------------
-- cooks.adb
--
-- Implementation of the cooks.
------------------------------------------------------------------------------
with Ada.Strings.Unbounded, Randoms, Meals, Reporter;
use Ada.Strings.Unbounded, Randoms, Meals, Reporter;
package body Cooks is
task body Cook is
My_Name : Unbounded_String; -- Identification of the cook
Current_Order : Order; -- What she's currently preparing
procedure Cook_The_Order is
begin
Report (My_Name & " is cooking " & Current_Order.Food);
delay Duration(Random(3.0, 8.0));
Report (My_Name & " puts " & Current_Order.Food & " under heat lamp");
Heat_Lamp.Write (Current_Order);
end Cook_The_Order;
procedure Coffee_Break is
begin
Report (My_Name & " on coffee break");
delay 10.0;
Report (My_Name & " returns from coffee break");
end Coffee_Break;
begin
accept Here_Is_Your_Name (Name: Cook_Name) do
My_Name := To_Unbounded_String(Cook_Name'Image(Name));
end Here_Is_Your_Name;
Report (My_Name & " clocking in");
Life_Cycle: loop
for I in 1..4 loop -- coffee break every fourth meal
select
accept Prepare (O: Order) do
Current_Order := O; -- small critical section,
end Prepare; -- ... don't hold waiter up!!
Cook_The_Order;
or
accept Pink_Slip; -- fired!
exit Life_Cycle;
end select;
end loop; -- end of cooking four meals
Coffee_Break; -- now take a break
end loop Life_Cycle; -- end of 4-meal--break cycle
Report (My_Name & " clocking out");
exception
when others => Report ("Error: Cook unexpectedly dead from heart attack");
end Cook;
end Cooks;
Waiters run back and forth between the table and the kitchen, as long as the host is alive. When they finally see it is time to go home, they leave, but they decrement a countdown object so the whole simulation can exit cleanly. To get the details of their life, read the source:
------------------------------------------------------------------------------
-- waiters.ads
--
-- This package supplies a task type for the Waiters in the Enhanced Dining
-- Philosophers simulation, and an array of waiters.
--
-- Entries:
--
-- Here_Is_Your_Name (Name) assigns the name Name to the waiter.
-- Place_Order(O, P, Available) gets order O from Philosopher P and
-- returns whether a cook is immediately
-- available to cook it.
--
-- Behavior:
--
-- A waiter does nothing until assigned a name; then he reports in. At work
-- a waiter runs back and forth between the table and the kitchen. At the
-- table he tries to pick up an order from a customer, but he only waits
-- five seconds for one. If he picks one up he takes it to the kitchen and
-- tries to get a chef to cook it. If none of the cooks are immediately
-- available the waiter gives a coupon to the philosopher that placed the
-- order. At the kitchen the waiter waits up to two seconds to pick up an
-- order from the heat lamp, and then delivers it to the philosopher that
-- ordered it.
--
-- Termination:
--
-- A waiter dies naturally (by completing its task body) whenever he notes
-- that the host has died. Before dying, he checks to see if he is the last
-- waiter to leave (by decrementing and testing a protected counter) and if
-- so, he "locks up" the restaurant (reports that it is closing).
------------------------------------------------------------------------------
with Names, Orders;
use Names, Orders;
package Waiters is
task type Waiter is
entry Here_Is_Your_Name (Name: Waiter_Name);
entry Place_Order(An_Order: Order;
Customer: Philosopher_Name;
Cook_Immediately_Available: out boolean);
end Waiter;
Waiter_Array: array (Waiter_Name) of Waiter;
end Waiters;
------------------------------------------------------------------------------
-- waiters.adb
--
-- Implementation of the waiters.
------------------------------------------------------------------------------
with Philosophers, Cooks, Host, Meals, Orders, Reporter, Protected_Counters;
use Philosophers, Cooks, Host, Meals, Orders, Reporter, Protected_Counters;
with Ada.Exceptions, Ada.Strings.Unbounded, Ada.Text_IO;
use Ada.Exceptions, Ada.Strings.Unbounded;
package body Waiters is
Waiters_Alive: Counter(Waiter_Array'Length);
task body Waiter is
My_Name: Unbounded_String;
procedure Report_For_Work is
begin
Report (My_Name & " clocking in");
end Report_For_Work;
procedure Retrieve_Food_From_Kitchen_If_Possible is
An_Order: Order;
begin
select
Heat_Lamp.Read (An_Order);
Report (My_Name & " gets " & An_Order.Food & " from heat lamp");
Report (My_Name & " serves " & An_Order.Food);
Philosopher_Array(An_Order.Diner).Here_Is_Your_Food;
or
delay 2.0;
Report (My_Name & " found no food at heat lamp");
end select;
end Retrieve_Food_From_Kitchen_If_Possible;
procedure Go_Home is
Is_Zero: Boolean;
begin
Report (My_Name & " clocking out");
Waiters_Alive.Decrement_And_Test_If_Zero (Is_Zero);
if Is_Zero then
Report ("The restaurant is closing down for the night");
end if;
end Go_Home;
begin
accept Here_Is_Your_Name (Name: Waiter_Name) do
My_Name := To_Unbounded_String(Waiter_Name'Image(Name));
end Here_Is_Your_Name;
Report_For_Work;
while not Norman_Bates'Terminated loop
select
accept Place_Order(An_Order: Order;
Customer: Philosopher_Name;
Cook_Immediately_Available: out boolean) do
Cook_Immediately_Available := False;
Report (My_Name & " takes an order from " & Philosopher_Name'Image(Customer));
for C in Cook_Array'Range loop
select
Cook_Array(C).Prepare(An_Order);
Cook_Immediately_Available := True;
exit;
else
null;
end select;
end loop;
end Place_Order;
or
delay 5.0;
end select;
Retrieve_Food_From_Kitchen_If_Possible;
end loop;
Go_Home;
exception
when E: others =>
Report ("Error: " & My_Name & " unexpectedly dead from "
& Exception_Information(E));
end Waiter;
end Waiters;
These weirdos just come in, sit down, think, order, eat, and leave, over and over again, until they run out of money and die. Again, check the source below. See how they stubbornly eat with chopsticks fetched one after the other, and see how they get fed up with lousy service and receive their coupons if no cook can start working on their order right away.
------------------------------------------------------------------------------
-- philosophers.ads
--
-- This package supplies a task type for the Philosophers in the Enhanced
-- Dining Philosophers simulation. It also defines an array of philosophers.
--
-- Entries:
--
-- Here_Is_Your_Name (Name) assigns the name Name to the philosopher.
-- Here_Is_Your_Food gives the philosopher what she ordered.
--
-- Behavior:
--
-- First the philosopher waits for a name, then enters a life cycle of com-
-- ing into the restaurant, thinking, ordering, then ((eating and paying) or
-- (getting a coupon) or (complaining)), then leaving.
--
-- Termination:
--
-- A philosopher "dies" be running out of money and just reaching the end of
-- its task body.
--
-- Note:
--
-- To keep the simulation from running too long, philosophers start with $30
-- and coupons are worth $5.
------------------------------------------------------------------------------
with Names, Orders;
use Names, Orders;
package Philosophers is
task type Philosopher is
entry Here_Is_Your_Name (Name: Philosopher_Name);
entry Here_Is_Your_Food;
end Philosopher;
Philosopher_Array : array (Philosopher_Name) of Philosopher;
end Philosophers;
------------------------------------------------------------------------------
-- philosophers.adb
--
-- Implementation of the philosophers.
------------------------------------------------------------------------------
with Randoms, Meals, Chopsticks, Host, Orders, Reporter, Waiters;
use Randoms, Meals, Chopsticks, Host, Orders, Reporter, Waiters;
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;
with Ada.Text_IO;
package body Philosophers is
task body Philosopher is
My_Index : Philosopher_Name;
My_Name : Unbounded_String;
Wealth : Float := 30.00;
Left : Chopstick_Name;
Right : Chopstick_Name;
My_Order : Order;
Cooking : Boolean;
begin
accept Here_Is_Your_Name (Name: Philosopher_Name) do
My_Index := Name;
My_Name := To_Unbounded_String(Philosopher_Name'Image(Name));
end Here_Is_Your_Name;
Left := Chopstick_Name(Philosopher_Name'Pos(My_Index));
Right := (Chopstick_Name'Pos(Left) + 1) mod (Chopstick_Name'Last + 1);
while Wealth > 0.0 loop
Norman_Bates.Enter;
Report (My_Name & " enters the cafe");
Report (My_Name & " is thinking");
delay Duration(Random(1,3));
My_Order := (My_Index, Random_Meal);
Report (My_Name & " has decided to order " & My_Order.Food);
select
Waiter_Array(Waiter_Name'Val(Random(0,1))).Place_Order(My_Order, My_Index, Cooking);
or
delay 35.0;
Report (My_Name & " cancels order and complains about lousy service");
end select;
if Cooking then
accept Here_Is_Your_Food;
Chopstick_Array(Right).Pick_Up;
Chopstick_Array(Left).Pick_Up;
Report (My_Name & " is eating " & My_Order.Food);
delay (12.0);
Chopstick_Array(Right).Put_Down;
Chopstick_Array(Left).Put_Down;
Report (My_Name & " pays for the " & My_Order.Food);
Wealth := Wealth - Price(My_Order.Food);
else
Report (My_Name & " receives a coupon");
Wealth := Wealth + 5.00;
end if;
Report (My_Name & " leaves the restaurant");
Norman_Bates.Leave;
end loop;
Report (My_Name & " died a normal death from overeating");
Norman_Bates.Death_Announcement;
exception
when others => Report ("Error: " & My_Name & " dead unexpectedly");
end Philosopher;
end Philosophers;
Nothing fancy here! Chopsticks are elegantly represented with protected objects. Well, one thing that is moderately cool is that we can put the array of chopsticks in the same package as the chopstick type. Or, wait, maybe that's not too cool. Maybe that's too tightly coupled. Hmmm.
------------------------------------------------------------------------------
-- chopsticks.ads
--
-- This package supplies a task type for the Chosticks in the Enhanced Dining
-- Philosophers simulation and also an array of Chopsticks.
--
-- Entries:
--
-- Pick_Up call this to pick the chopstick up.
-- Put_Down call this to put the chopstick down.
--
-- Behavior:
--
-- A chopstick is first picked up, then put down, then picked up, then put
-- down, and so on.
------------------------------------------------------------------------------
with Names;
use Names;
package Chopsticks is
protected type Chopstick is
entry Pick_Up;
entry Put_Down;
private
Up: Boolean := False;
end Chopstick;
Chopstick_Array: array (Chopstick_Name) of Chopstick;
end Chopsticks;
------------------------------------------------------------------------------
-- chopsticks.adb
--
-- Implementation of the Chopsticks package.
------------------------------------------------------------------------------
package body Chopsticks is
protected body Chopstick is
entry Pick_Up when not Up is
begin
Up := True;
end Pick_Up;
entry Put_Down when Up is
begin
Up := False;
end Put_Down;
end Chopstick;
end Chopsticks;
The host controls the simulation, keeping the philosophers from deadlocking while they are alive.
------------------------------------------------------------------------------
-- host.ads
--
-- This package defines the task for the host. The host allows the philoso-
-- phers to enter and leave the restaurant. It also keeps track of how many
-- philosophers have died. The host is called Norman_Bates.
--
-- Entries:
--
-- Enter Allows you to enter the restaurant provided there are
-- at least two empty seats.
-- Leave Allows you to leave the restaurant.
-- Death_Announcement Records the fact that a philosopher has died.
--
-- Behavior:
--
-- The host just sits around waiting for someone to ask him to escort her
-- in to or out of the restaurant, or to inform him of a (philosopher's)
-- death. He will take requests to be seated only if there are at least two
-- free seats at the table. He will take requests to leave at any time.
-- After all the philosophers have informed him of their deaths, he will
-- fire all the cooks.
--
-- Termination:
--
-- The host keeps track of how many philosophers are alive. When this count
-- reaches zero, he will fire all the cooks and then subsequently terminate
-- himself.
--
-- Note:
--
-- The use of a host in the Dining Philosophers Problem is controversial be-
-- cause the system relies on the "ethics" of our philosophers. The phil-
-- osophers must be honest and always use the host to enter and leave, and
-- always inform the host that they are dead (or terminally ill and unable
-- to eat again!) One advantage, though, of having the philosophers inform-
-- ing the host of their death is that the host does not need to poll to see
-- how many philosophers are alive.
------------------------------------------------------------------------------
package Host is
task Norman_Bates is
entry Enter;
entry Leave;
entry Death_Announcement;
end Norman_Bates;
end Host;
------------------------------------------------------------------------------
-- host.adb
--
-- Implementation of the host.
------------------------------------------------------------------------------
with Chopsticks, Cooks, Reporter;
use Chopsticks, Cooks, Reporter;
package body Host is
task body Norman_Bates is
-- Here is a variable to keep track of the number of empty seats.
-- Initially all seats are empty, so the number of empty seats is
-- the actual number of seats we have, which is equal to the number
-- of chopsticks, i.e. the number of elements in Chopstick_Array.
Number_Of_Empty_Seats: Natural := Chopstick_Array'Length;
-- Here is a variable to keep track of the number of living philosophers.
-- Initially all philosophers are alive, so the number of living
-- philosophers is equal to the number of total philosophers, which
-- is the same as the number of initially empty seats.
Number_Of_Living_Philosophers: Natural := Number_Of_Empty_Seats;
begin
Report ("The host is coming to life");
-- Loop around, doing host things:
loop
select
accept Leave do
Number_Of_Empty_Seats := Number_Of_Empty_Seats + 1;
end Leave;
or
when (Number_Of_Empty_Seats >= 2) =>
accept Enter do
Number_Of_Empty_Seats := Number_Of_Empty_Seats - 1;
end Enter;
or
accept Death_Announcement;
Number_Of_Living_Philosophers := Number_Of_Living_Philosophers - 1;
exit when Number_Of_Living_Philosophers = 0;
end select;
end loop;
-- Fire all the cooks:
for I in Cook_Array'Range loop
Cook_Array(I).Pink_Slip;
end loop;
end Norman_Bates;
end Host;
The simulation is launched with a main procedure. Nothing too fancy, really. The most interesting thing is that it serializes construction of the active simulation objects, making sure the cooks are fully initialized before the waiters, and that the waiters are initialized before the philosophers.
------------------------------------------------------------------------------
-- edp.adb
--
-- A compact Ada 95 simulation of the Enhanced Dining Philosophers Problem.
-- By "compact" it is meant that tasks representing simulation objects are
-- actually made visible to the simulation program as a whole rather than
-- being hidden in packages.
--
-- The objects in the simulation are:
--
-- 5 philosophers;
-- 5 chopsticks;
-- 2 waiters;
-- 3 cooks;
-- A host, who lets the philosophers into the restaurant and escorts them
-- out.
-- Meals, which are certain combinations of foods served by the restaurant;
-- Orders, which are of the form [philosopher, meal];
-- A heat lamp, under which cooks place the cooked orders and from which the
-- waiters pick them up (to bring them back to the philosophers);
-- A reporter, for logging events.
--
-- This is the main subprogram, EDP. The entire program consists of twelve
-- packages and this subprogram. Four packages are very general utilities;
-- the other eight are intrinsic to the simulation. The packages are
--
-- Randoms a collection of operations producing randoms
-- Protected_Counters exports a protected type Protected_Counter
-- Buffers generic package with bounded, blocking queue ADT
-- Reporter unsophisticated package for serializing messages
--
-- Names names for the simulation objects
-- Meals Meal datatype and associated operations
-- Orders Order datatype, order-bin, and heat-lamp
-- Chopsticks the chopsticks
-- Cooks the cooks
-- Host the host
-- Philosophers the philosophers
-- Waiters the waiters
--
-- The main subprogram simply reports that the restaurant is open and then
-- initializes all library tasks. The restaurant will be "closed" by the last
-- waiter to leave.
------------------------------------------------------------------------------
with Ada.Text_IO, Philosophers, Waiters, Cooks, Reporter;
use Ada.Text_IO, Philosophers, Waiters, Cooks, Reporter;
procedure EDP is
begin
Report ("The restaurant is open for business");
for C in Cook_Array'Range loop
Cook_Array(C).Here_Is_Your_Name(C);
end loop;
for W in Waiter_Array'Range loop
Waiter_Array(W).Here_Is_Your_Name(W);
end loop;
for P in Philosopher_Array'Range loop
Philosopher_Array(P).Here_Is_Your_Name(P);
end loop;
end EDP;
To build and run this application, put all the source files into one directory and execute
gnatmake edp edp
... Is left as an exercise for the reader. Use Java 1.5 at least. Please.