Ada 风格指南/可移植的进餐哲学家示例
< Ada 风格指南
本章介绍了 Edsger Dijkstra 著名的进餐哲学家的详细实现；这是并发编程中死锁问题的经典演示。此示例演示了 Ada 包和任务的可移植性，并说明了许多 Ada 95 质量和风格指南。由于许多指南让程序员自行决定最佳方案，因此不存在单一的最佳或正确示例来演示如何使用 Ada。相反，你会发现几种与你自己的风格不同的风格，它们可能值得考虑。
--::::::::::
--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;
此版本的进餐哲学家示例由乔治华盛顿大学的 Michael B. Feldman 博士和瑞典 CelciusTech Systems 的 Bjorn Kallberg 提供。此示例使用 GNAT Ada 95 编译器 2.07 版在 Sun 平台上编译。