11. Complete Example
This chapter presents an elaborate implementation of Edsger Dijkstra's famous Dining Philosophers; a classical demonstration of deadlock problems in concurrent programming. This example demonstrates the portability of Ada packages and tasking and illustrates many of the Ada 95 quality and style guidelines. Since many of the guidelines leave the program writer to decide what is best, there is no single best or correct example of how to use Ada. Instead, you will find several styles that differ from your own that may deserve consideration.
--::::::::::
--random_generic.ads
--::::::::::
generic
type Result_Subtype is (<>);
package Random_Generic is
-- Simple integer pseudo-random number generator package.
-- Michael B. Feldman, The George Washington University,
-- June 1995.
function Random_Value return Result_Subtype;
end Random_Generic;
--::::::::::
--screen.ads
--::::::::::
package Screen is
-- simple ANSI terminal emulator
-- Michael Feldman, The George Washington University
-- July, 1995
ScreenHeight : constant Integer := 24;
ScreenWidth : constant Integer := 80;
subtype Height is Integer range 1 .. ScreenHeight;
subtype Width is Integer range 1 .. ScreenWidth;
type Position is record
Row : Height := 1;
Column : Width := 1;
end record;
procedure Beep;
-- Pre: none
-- Post: the terminal beeps once
procedure ClearScreen;
-- Pre: none
-- Post: the terminal screen is cleared
procedure MoveCursor (To : in Position);
-- Pre: To is defined
-- Post: the terminal cursor is moved to the given position
end Screen;
--::::::::::
--windows.ads
--::::::::::
with Screen;
package Windows is
-- manager for simple, nonoverlapping screen windows
-- Michael Feldman, The George Washington University
-- July, 1995
type Window is private;
function Open (UpperLeft : Screen.Position;
Height : Screen.Height;
Width : Screen.Width) return Window;
-- Pre: W, Height, and Width are defined
-- Post: returns a Window with the given upper-left corner,
-- height, and width
procedure Title (W : in out Window;
Name : in String;
Under : in Character);
-- Pre: W, Name, and Under are defined
-- Post: Name is displayed at the top of the window W, underlined
-- with the character Under.
procedure Borders (W : in out Window;
Corner : in Character
Down : in Character
Across : in Character);
-- Pre: All parameters are defined
-- Post: Draw border around current writable area in window with
-- characters specified. Call this BEFORE Title.
procedure MoveCursor (W : in out Window;
P : in Screen.Position);
-- Pre: W and P are defined, and P lies within the area of W
-- Post: Cursor is moved to the specified position.
-- Coordinates are relative to the
-- upper left corner of W, which is (1, 1)
procedure Put (W : in out Window;
Ch : in Character);
-- Pre: W and Ch are defined.
-- Post: Ch is displayed in the window at
-- the next available position.
-- If end of column, go to the next row.
-- If end of window, go to the top of the window.
procedure Put (W : in out Window;
S : in String);
-- Pre: W and S are defined
-- Post: S is displayed in the window, "line-wrapped" if necessary
procedure New_Line (W : in out Window);
-- Pre: W is defined
-- Post: Cursor moves to beginning of next line of W;
-- line is not blanked until next character is written
private
type Window is record
First : Screen.Position; -- coordinates of upper left
Last : Screen.Position; -- coordinates of lower right
Current : Screen.Position; -- current cursor position
end record;
end Windows;
--::::::::::
--Picture.ads
--::::::::::
with Windows;
with Screen;
package Picture is
-- Manager for semigraphical presentation of the philosophers
-- i.e. more application oriented windows, build on top of
-- the windows package.
-- Each picture has an orientation, which defines which borders
-- top-bottom, bottom-top, left-right, or right-left correspond
-- to the left and right hand of the philosopher.
--
-- Bjorn Kallberg, CelsiusTech Systems, Sweden
-- July, 1995
type Root is abstract tagged private;
type Root_Ptr is access Root'Class;
procedure Open (W : in out Root;
UpperLeft : in Screen.Position;
Height : in Screen.Height;
Width : in Screen.Width);
-- Pre: Not opened
-- Post: An empty window exists
procedure Title (W : in out Root;
Name : in String);
-- Pre: An empty window
-- Post: Name and a border is drawn.
procedure Put_Line (W : in out Root;
S : in String);
procedure Left_Fork (W : in out Root;
Pick : in Boolean) is abstract;
procedure Right_Fork (W : in out Root;
Pick : in Boolean) is abstract;
-- left and right relates to philosopher position around table
type North is new Root with private;
type South is new Root with private;
type East is new Root with private;
type West is new Root with private;
private
type Root is abstract tagged record
W : Windows.Window;
end record;
type North is new Root with null record;
type South is new Root with null record;
type East is new Root with null record;
type West is new Root with null record;
procedure Left_Fork (W : in out North;
Pick : in Boolean);
procedure Right_Fork (W : in out North;
Pick : in Boolean);
procedure Left_Fork (W : in out South;
Pick : in Boolean);
procedure Right_Fork (W : in out South;
Pick : in Boolean);
procedure Left_Fork (W : in out East;
Pick : in Boolean);
procedure Right_Fork (W : in out East;
Pick : in Boolean);
procedure Left_Fork (W : in out West;
Pick : in Boolean);
procedure Right_Fork (W : in out West;
Pick : in Boolean);
end Picture;
--::::::::::
--chop.ads
--::::::::::
package Chop is
-- Dining Philosophers - Ada 95 edition
-- Chopstick is an Ada 95 protected type
-- Michael B. Feldman, The George Washington University,
-- July, 1995.
protected type Stick is
entry Pick_Up;
procedure Put_Down;
private
In_Use: Boolean := False;
end Stick;
end Chop;
--::::::::::
--society.ads
--::::::::::
package Society is
-- Dining Philosophers - Ada 95 edition
-- Society gives unique ID's to people, and registers their names
-- Michael B. Feldman, The George Washington University,
-- July, 1995.
subtype Unique_DNA_Codes is Positive range 1 .. 5;
Name_Register : array (Unique_DNA_Codes) of String (1 .. 18) :=
("Edsger Dijkstra ",
"Bjarne Stroustrup ",
"Chris Anderson ",
"Tucker Taft ",
"Jean Ichbiah ");
end Society;
--::::::::::
--phil.ads
--::::::::::
with Society;
package Phil is
-- Dining Philosophers - Ada 95 edition
-- Philosopher is an Ada 95 task type with discriminant
-- Michael B. Feldman, The George Washington University,
-- July 1995
--
-- Revisions:
-- July 1995. Bjorn Kallberg, CelsiusTech
-- Reporting left or right instead of first stick
task type Philosopher (My_ID : Society.Unique_DNA_Codes) is
entry Start_Eating (Chopstick1 : in Positive;
Chopstick2 : in Positive);
end Philosopher;
type States is (Breathing, Thinking, Eating, Done_Eating,
Got_Left_Stick, Got_Right_Stick, Got_Other_Stick, Dying);
end Phil;
--::::::::::
--room.ads
--::::::::::
with Chop;
with Phil;
with Society;
package Room is
-- Dining Philosophers - Ada 95 edition
-- Room.Maitre_D is responsible for assigning seats at the
-- table, "left" and "right" chopsticks, and for reporting
-- interesting events to the outside world.
-- Michael B. Feldman, The George Washington University,
-- July, 1995.
Table_Size : constant := 5;
subtype Table_Type is Positive range 1 .. Table_Size;
Sticks : array (Table_Type) of Chop.Stick;
task Maitre_D is
entry Start_Serving;
entry Report_State (Which_Phil : in Society.Unique_DNA_Codes;
State : in Phil.States;
How_Long : in Natural := 0;
Which_Meal : in Natural := 0);
end Maitre_D;
end Room;
--::::::::::
--random_generic.adb
--::::::::::
with Ada.Numerics.Discrete_Random;
package body Random_Generic is
-- Body of random number generator package.
-- Uses Ada 95 random number generator; hides generator parameters
-- Michael B. Feldman, The George Washington University,
-- June 1995.
package Ada95_Random is new Ada.Numerics.Discrete_Random
(Result_Subtype => Result_Subtype);
G : Ada95_Random.Generator;
function Random_Value return Result_Subtype is
begin
return Ada95_Random.Random (Gen => G);
end Random_Value;
begin -- Random_Generic
Ada95_Random.Reset (Gen => G); -- time-dependent initialization
end Random_Generic;
--::::::::::
--screen.adb
--::::::::::
with Text_IO;
package body Screen is
-- simple ANSI terminal emulator
-- Michael Feldman, The George Washington University
-- July, 1995
-- These procedures will work correctly only if the actual
-- terminal is ANSI compatible. ANSI.SYS on a DOS machine
-- will suffice.
package Int_IO is new Text_IO.Integer_IO (Num => Integer);
procedure Beep is
begin
Text_IO.Put (Item => ASCII.BEL);
end Beep;
procedure ClearScreen is
begin
Text_IO.Put (Item => ASCII.ESC);
Text_IO.Put (Item => "[2J");
end ClearScreen;
procedure MoveCursor (To : in Position) is
begin
Text_IO.New_Line;
Text_IO.Put (Item => ASCII.ESC);
Text_IO.Put ("[");
Int_IO.Put (Item => To.Row, Width => 1);
Text_IO.Put (Item => ';');
Int_IO.Put (Item => To.Column, Width => 1);
Text_IO.Put (Item => 'f');
end MoveCursor;
end Screen;
--::::::::::
--windows.adb
--::::::::::
with Text_IO, with Screen;
package body Windows is
-- manager for simple, nonoverlapping screen windows
-- Michael Feldman, The George Washington University
-- July, 1995
function Open (UpperLeft : Screen.Position;
Height : Screen.Height;
Width : Screen.Width) return Window is
Result : Window;
begin
Result.Current := UpperLeft;
Result.First := UpperLeft;
Result.Last := (Row => UpperLeft.Row + Height - 1,
Column => UpperLeft.Column + Width - 1);
return Result;
end Open;
procedure EraseToEndOfLine (W : in out Window) is
begin
Screen.MoveCursor (W.Current);
for Count in W.Current.Column .. W.Last.Column loop
Text_IO.Put (' ');
end loop;
Screen.MoveCursor (W.Current);
end EraseToEndOfLine;
procedure Put (W : in out Window;
Ch : in Character) is
begin
-- If at end of current line, move to next line
if W.Current.Column > W.Last.Column then
if W.Current.Row = W.Last.Row then
W.Current.Row := W.First.Row;
else
W.Current.Row := W.Current.Row + 1;
end if;
W.Current.Column := W.First.Column;
end if;
-- If at First char, erase line
if W.Current.Column = W.First.Column then
EraseToEndOfLine (W);
end if;
Screen.MoveCursor (To => W.Current);
-- here is where we actually write the character!
Text_IO.Put (Ch);
W.Current.Column := W.Current.Column + 1;
end Put;
procedure Put (W : in out Window;
S : in String) is
begin
for Count in S'Range loop
Put (W, S (Count));
end loop;
end Put;
procedure New_Line (W : in out Window) is
begin
if W.Current.Column = 1 then
EraseToEndOfLine (W);
end if;
if W.Current.Row = W.Last.Row then
W.Current.Row := W.First.Row;
else
W.Current.Row := W.Current.Row + 1;
end if;
W.Current.Column := W.First.Column;
end New_Line;
procedure Title (W : in out Window;
Name : in String;
Under : in Character) is
begin
-- Put name on top line
W.Current := W.First;
Put (W, Name);
New_Line (W);
-- Underline name if desired, and reduce the writable area
-- of the window by one line
if Under = ' ' then -- no underlining
W.First.Row := W.First.Row + 1;
else -- go across the row, underlining
for Count in W.First.Column .. W.Last.Column loop
Put (W, Under);
end loop;
New_Line (W);
W.First.Row := W.First.Row + 2; -- reduce writable area
end if;
end Title;
procedure Borders (W : in out Window;
Corner : in Character
Down : in Character
Across : in Character is
,
begin
-- Put top line of border
Screen.MoveCursor (W.First);
Text_IO.Put (Corner);
for Count in W.First.Column + 1 .. W.Last.Column - 1 loop
Text_IO.Put (Across);
end loop;
Text_IO.Put (Corner);
-- Put the two side lines
for Count in W.First.Row + 1 .. W.Last.Row - 1 loop
Screen.MoveCursor ((Row => Count, Column => W.First.Column));
Text_IO.Put (Down);
Screen.MoveCursor ((Row => Count, Column => W.Last.Column));
Text_IO.Put (Down);
end loop;
-- Put the bottom line of the border
Screen.MoveCursor ((Row => W.Last.Row, Column => W.First.Column));
Text_IO.Put (Corner);
for Count in W.First.Column + 1 .. W.Last.Column - 1 loop
Text_IO.Put (Across);
end loop;
Text_IO.Put (Corner);
-- Make the Window smaller by one character on each side
W.First := (Row => W.First.Row + 1, Column => W.First.Column + 1);
W.Last := (Row => W.Last.Row - 1, Column => W.Last.Column - 1);
W.Current := W.First;
end Borders;
procedure MoveCursor (W : in out Window;
P : in Screen.Position) is
-- Relative to writable Window boundaries, of course
begin
W.Current.Row := W.First.Row + P.Row;
W.Current.Column := W.First.Column + P.Column;
end MoveCursor;
begin -- Windows
Text_IO.New_Line;
Screen.ClearScreen;
Text_IO.New_Line;
end Windows;
--------------------
package Windows.Util is
--
-- Child package to change the borders of an existing window
-- Bjorn Kallberg, CelsiusTech Systems, Sweden
-- July, 1995.
-- call these procedures after border and title
procedure Draw_Left (W : in out Window;
C : in Character);
procedure Draw_Right (W : in out Window;
C : in Character);
procedure Draw_Top (W : in out Window;
C : in Character);
procedure Draw_Bottom (W : in out Window;
C : in Character);
end Windows.Util;
--------------------
with Text_IO;
package body Windows.Util is
-- Bjorn Kallberg, CelsiusTech Systems, Sweden
-- July, 1995.
-- When making borders and titles, the size has shrunk, so
-- we must now draw outside the First and Last points
procedure Draw_Left (W : in out Window;
C : in Character) is
begin
for R in W.First.Row - 3 .. W.Last.Row + 1 loop
Screen.MoveCursor ((Row => R, Column => W.First.Column-1));
Text_IO.Put (C);
end loop;
end;
procedure Draw_Right (W : in out Window;
C : in Character) is
begin
for R in W.First.Row - 3 .. W.Last.Row + 1 loop
Screen.MoveCursor ((Row => R, Column => W.Last.Column + 1));
Text_IO.Put (C);
end loop;
end;
procedure Draw_Top (W : in out Window;
C : in Character) is
begin
for I in W.First.Column - 1 .. W.Last.Column + 1 loop
Screen.MoveCursor ((Row => W.First.Row - 3, Column => I));
Text_IO.Put (C);
end loop;
end;
procedure Draw_Bottom (W : in out Window;
C : in Character) is
begin
for I in W.First.Column - 1 .. W.Last.Column + 1 loop
Screen.MoveCursor ((Row => W.Last.Row + 1, Column => I));
Text_IO.Put (C);
end loop;
end;
end Windows.Util;
--::::::::::
--Picture.adb
--::::::::::
with Windows.Util;
package body Picture is
--
-- Bjorn Kallberg, CelsiusTech Systems, Sweden
-- July, 1995
function Vertical_Char (Stick : Boolean) return Character is
begin
if Stick then
return '#';
else
return ':';
end if;
end;
function Horizontal_Char (Stick : Boolean) return Character is
begin
if Stick then
return '#';
else
return '-';
end if;
end;
procedure Open (W : in out Root;
UpperLeft : in Screen.Position;
Height : in Screen.Height;
Width : in Screen.Width) is
begin
W.W := Windows.Open (UpperLeft, Height, Width);
end;
procedure Title (W : in out Root;
Name : in String) is
-- Pre: An empty window
-- Post: Name and a boarder is drawn.
begin
Windows.Borders (W.W, '+', ':', '-');
Windows.Title (W.W, Name,'-');
end;
procedure Put_Line (W : in out Root;
S : in String) is
begin
Windows.Put (W.W, S);
Windows.New_Line (W.W);
end;
-- North
procedure Left_Fork (W : in out North;
Pick : in Boolean) is
begin
Windows.Util.Draw_Right (W.W, Vertical_Char (Pick));
end;
procedure Right_Fork (W : in out North;
Pick : in Boolean) is
begin
Windows.Util.Draw_Left (W.W, Vertical_Char (Pick));
end;
-- South
procedure Left_Fork (W : in out South;
Pick : in Boolean) is
begin
Windows.Util.Draw_Left (W.W, Vertical_Char (Pick));
end;
procedure Right_Fork (W : in out South;
Pick : in Boolean) is
begin
Windows.Util.Draw_Right (W.W, Vertical_Char (Pick));
end;
-- East
procedure Left_Fork (W : in out East;
Pick : in Boolean) is
begin
Windows.Util.Draw_Bottom (W.W, Horizontal_Char (Pick));
end;
procedure Right_Fork (W : in out East;
Pick : in Boolean) is
begin
Windows.Util.Draw_Top (W.W, Horizontal_Char (Pick));
end;
-- West
procedure Left_Fork (W : in out West;
Pick : in Boolean) is
begin
Windows.Util.Draw_Top (W.W, Horizontal_Char (Pick));
end;
procedure Right_Fork (W : in out West;
Pick : in Boolean) is
begin
Windows.Util.Draw_Bottom (W.W, Horizontal_Char (Pick));
end;
end Picture;
--::::::::::
--chop.adb
--::::::::::
package body Chop is
-- Dining Philosophers - Ada 95 edition
-- Chopstick is an Ada 95 protected type
-- Michael B. Feldman, The George Washington University,
-- July, 1995.
protected body Stick is
entry Pick_Up when not In_Use is
begin
In_Use := True;
end Pick_Up;
procedure Put_Down is
begin
In_Use := False;
end Put_Down;
end Stick;
end Chop;
--::::::::::
--phil.adb
--::::::::::
with Society;
with Room;
with Random_Generic;
package body Phil is
-- Dining Philosophers - Ada 95 edition
-- Philosopher is an Ada 95 task type with discriminant.
-- Chopsticks are assigned by a higher authority, which
-- can vary the assignments to show different algorithms.
-- Philosopher always grabs First_Grab, then Second_Grab.
-- Philosopher is oblivious to outside world, but needs to
-- communicate is life-cycle events the Maitre_D.
-- Chopsticks assigned to one philosopher must be
-- consecutive numbers, or the first and last chopstick.
-- Michael B. Feldman, The George Washington University,
-- July, 1995.
-- Revisions:
-- July, 1995. Bjorn Kallberg, CelsiusTech
subtype Think_Times is Positive range 1 .. 8;
package Think_Length is
new Random_Generic (Result_Subtype => Think_Times);
subtype Meal_Times is Positive range 1 .. 10;
package Meal_Length is
new Random_Generic (Result_Subtype => Meal_Times);
task body Philosopher is -- My_ID is discriminant
subtype Life_Time is Positive range 1 .. 5;
Who_Am_I : Society.Unique_DNA_Codes := My_ID; -- discriminant
First_Grab : Positive;
Second_Grab : Positive;
Meal_Time : Meal_Times;
Think_Time : Think_Times;
First_Stick : States;
begin
-- get assigned the first and second chopsticks here
accept Start_Eating (Chopstick1 : in Positive;
Chopstick2 : in Positive) do
First_Grab := Chopstick1;
Second_Grab := Chopstick2;
if (First_Grab mod Room.Table_Type'Last) + 1 = Second_Grab then
First_Stick := Got_Right_Stick;
else
First_Stick := Got_Left_Stick;
end if;
end Start_Eating;
Room.Maitre_D.Report_State (Who_Am_I, Breathing);
for Meal in Life_Time loop
Room.Sticks (First_Grab).Pick_Up;
Room.Maitre_D.Report_State (Who_Am_I, First_Stick, First_Grab);
Room.Sticks (Second_Grab).Pick_Up;
Room.Maitre_D.Report_State (Who_Am_I, Got_Other_Stick, Second_Grab);
Meal_Time := Meal_Length.Random_Value;
Room.Maitre_D.Report_State (Who_Am_I, Eating, Meal_Time, Meal);
delay Duration (Meal_Time);
Room.Maitre_D.Report_State (Who_Am_I, Done_Eating);
Room.Sticks (First_Grab).Put_Down;
Room.Sticks (Second_Grab).Put_Down;
Think_Time := Think_Length.Random_Value;
Room.Maitre_D.Report_State (Who_Am_I, Thinking, Think_Time);
delay Duration (Think_Time);
end loop;
Room.Maitre_D.Report_State (Who_Am_I, Dying);
end Philosopher;
end Phil;
--::::::::::
--room.adb
--::::::::::
with Picture;
with Chop;
with Phil;
with Society;
with Calendar;
pragma Elaborate (Phil);
package body Room is
-- Dining Philosophers, Ada 95 edition
-- A line-oriented version of the Room package
-- Michael B. Feldman, The George Washington University,
-- July, 1995.
-- Revisions
-- July, 1995. Bjorn Kallberg, CelsiusTech Systems, Sweden.
-- Pictorial display of stick in use
-- philosophers sign into dining room, giving Maitre_D their DNA code
Dijkstra : aliased Phil.Philosopher (My_ID => 1);
Stroustrup : aliased Phil.Philosopher (My_ID => 2);
Anderson : aliased Phil.Philosopher (My_ID => 3);
Taft : aliased Phil.Philosopher (My_ID => 4);
Ichbiah : aliased Phil.Philosopher (My_ID => 5);
type Philosopher_Ptr is access all Phil.Philosopher;
Phils : array (Table_Type) of Philosopher_Ptr;
Phil_Pics : array (Table_Type) of Picture.Root_Ptr;
Phil_Seats : array (Society.Unique_DNA_Codes) of Table_Type;
task body Maitre_D is
T : Natural;
Start_Time : Calendar.Time;
Blanks : constant String := " ";
begin
accept Start_Serving;
Start_Time := Calendar.Clock;
-- now Maitre_D assigns phils to seats at the table
Phils :=
(Dijkstra'Access,
Anderson'Access,
Ichbiah'Access,
Taft'Access,
Stroustrup'Access);
-- Which seat each phil occupies.
for I in Table_Type loop
Phil_Seats (Phils(I).My_Id) := I;
end loop;
Phil_Pics :=
(new Picture.North,
new Picture.East,
new Picture.South,
new Picture.South,
new Picture.West);
Picture.Open (Phil_Pics(1).all,( 1, 24), 7, 30);
Picture.Open (Phil_Pics(2).all,( 9, 46), 7, 30);
Picture.Open (Phil_Pics(3).all,(17, 41), 7, 30);
Picture.Open (Phil_Pics(4).all,(17, 7), 7, 30);
Picture.Open (Phil_Pics(5).all,( 9, 2), 7, 30);
-- and assigns them their chopsticks.
Phils (1).Start_Eating (1, 2);
Phils (3).Start_Eating (3, 4);
Phils (2).Start_Eating (2, 3);
Phils (5).Start_Eating (1, 5);
Phils (4).Start_Eating (4, 5);
loop
select
accept Report_State (Which_Phil : in Society.Unique_DNA_Codes;
State : in Phil.States;
How_Long : in Natural := 0;
Which_Meal : in Natural := 0) do
T := Natural (Calendar."-" (Calendar.Clock, Start_Time));
case State is
when Phil.Breathing =>
Picture.Title (Phil_Pics (Phil_Seats (Which_Phil)).all,
Society.Name_Register (Which_Phil));
Picture.Put_line (Phil_Pics (Phil_Seats (Which_Phil)).all,
"T =" & Integer'Image (T) & " "
& "Breathing...");
when Phil.Thinking =>
Picture.Put_line (Phil_Pics (Phil_Seats (Which_Phil)).all,
"T =" & Integer'Image (T) & " "
& "Thinking"
& Integer'Image (How_Long) & " seconds.");
when Phil.Eating =>
Picture.Put_line (Phil_Pics (Phil_Seats (Which_Phil)).all,
"T =" & Integer'Image (T) & " "
& "Meal"
& Integer'Image (Which_Meal)
& ","
& Integer'Image (How_Long) & " seconds.");
when Phil.Done_Eating =>
Picture.Put_line (Phil_Pics (Phil_Seats (Which_Phil)).all,
"T =" & Integer'Image (T) & " "
& "Yum-yum (burp)");
Picture.Left_Fork (Phil_Pics (Phil_Seats (Which_Phil)).all, False);
Picture.Right_Fork (Phil_Pics (Phil_Seats (Which_Phil)).all, False);
when Phil.Got_Left_Stick =>
Picture.Put_line (Phil_Pics (Phil_Seats (Which_Phil)).all,
"T =" & Integer'Image (T) & " "
& "First chopstick"
& Integer'Image (How_Long));
Picture.Left_Fork (Phil_Pics (Phil_Seats (Which_Phil)).all, True);
when Phil.Got_Right_Stick =>
Picture.Put_line (Phil_Pics (Phil_Seats (Which_Phil)).all,
"T =" & Integer'Image (T) & " "
& "First chopstick"
& Integer'Image (How_Long));
Picture.Right_Fork (Phil_Pics (Phil_Seats (Which_Phil)).all, True);
when Phil.Got_Other_Stick =>
Picture.Put_line (Phil_Pics (Phil_Seats (Which_Phil)).all,
"T =" & Integer'Image (T) & " "
& "Second chopstick"
& Integer'Image (How_Long));
Picture.Left_Fork (Phil_Pics (Phil_Seats (Which_Phil)).all, True);
Picture.Right_Fork (Phil_Pics (Phil_Seats (Which_Phil)).all, True);
when Phil.Dying =>
Picture.Put_line (Phil_Pics (Phil_Seats (Which_Phil)).all,
"T =" & Integer'Image (T) & " "
& "Croak");
end case; -- State
end Report_State;
or
terminate;
end select;
end loop;
end Maitre_D;
end Room;
--::::::::::
--diners.adb
--::::::::::
with Text_IO;
with Room;
procedure Diners is
-- Dining Philosophers - Ada 95 edition
-- This is the main program, responsible only for telling the
-- Maitre_D to get busy.
-- Michael B. Feldman, The George Washington University,
-- July, 1995.
begin
--Text_IO.New_Line; -- artifice to flush output buffer
Room.Maitre_D.Start_Serving;
end Diners;
This version of the Dining Philosophers example was provided by Dr. Michael B. Feldman of the George Washington University and Bjorn Kallberg of CelciusTech Systems, Sweden. This example was compiled using the GNAT Ada 95 compiler, version 2.07, on a Sun platform.
note
This page of the "Ada Quality and Style Guide" has been adapted from the original work at https://en.wikibooks.org/wiki/Ada_Style_Guide, which is licensed under the Creative Commons Attribution-ShareAlike License; additional terms may apply. Page not endorsed by Wikibooks or the Ada Style Guide Wikibook authors. This page is licensed under the same license as the original work.