------------------------------------------------------------------------
with SPC_Numeric_Types;
use SPC_Numeric_Types;
package Random is
-- Simple pseudo-random number generator package.
-- Adapted from the Ada literature by
-- Michael B. Feldman, The George Washington University,
-- November 1990.
procedure Set_Seed (N : in Medium_Positive);
function Unit_Random return Medium_Float;
--returns a float >=0.0 and <1.0
function Random_Int (N : in Medium_Positive)
return Medium_Positive;
--return a random integer in the range 1..N
end Random;
------------------------------------------------------------------------
package Chop is
task type Stick is
entry Pick_Up;
entry Put_Down;
end Stick;
end Chop;
------------------------------------------------------------------------
with SPC_Numeric_Types;
use SPC_Numeric_Types;
package Phil is
task type Philosopher is
entry Come_To_Life (My_ID : in Medium_Natural;
Chopstick1 : in Medium_Natural;
Chopstick2 : in Medium_Natural);
end Philosopher;
type States is
(Breathing, Thinking, Eating, Done_Eating,
Got_One_Stick, Got_Other_Stick);
end Phil;
------------------------------------------------------------------------
with SPC_Numeric_Types;
use SPC_Numeric_Types;
with Chop;
with Phil;
package Room is
Table_Size : constant := 5;
subtype Table_Type is Medium_Natural range 1 .. Table_Size;
Sticks : array (Table_Type) of Chop.Stick;
task Head_Waiter is
entry Open_The_Room;
entry Report_State (Which_Phil : in Table_Type;
State : in Phil.States;
How_Long : in Medium_Natural := 0);
end Head_Waiter;
end Room;
------------------------------------------------------------------------
with Room;
procedure Diners is
begin
Room.Head_Waiter.Open_The_Room;
loop
delay 20.0;
end loop;
end Diners;
------------------------------------------------------------------------
with Calendar;
with SPC_Numeric_Types;
use Calendar;
use SPC_Numeric_Types;
package body Random is
-- Body of random number generator package.
-- Adapted from the Ada literature by
-- Michael B. Feldman, The George Washington University,
-- November 1990.
Modulus : constant := 9_317;
subtype Seed_Range is Medium_Integer range 0 .. Modulus - 1;
Seed : Seed_Range;
Default_Seed : Seed_Range;
procedure Set_Seed
(N : in Medium_Positive) is separate;
function Unit_Random
return Medium_Float is separate;
function Random_Int
(N : in Medium_Positive)
return Medium_Positive is separate;
begin
Default_Seed :=
Medium_Integer(Big_Integer(Seconds(Clock)) mod Modulus);
Seed := Default_Seed;
end Random;
------------------------------------------------------------------------
separate (Random)
procedure Set_Seed (N : in Medium_Positive) is
begin
Seed := Seed_Range(N);
end Set_Seed;
------------------------------------------------------------------------
separate (Random)
function Unit_Random return Medium_Float is
Multiplier : constant := 421;
Increment : constant := 2_073;
Result : Medium_Float;
begin -- Unit_Random
Seed := (Multiplier * Seed + Increment) mod Modulus;
Result := Medium_Float(Seed) / Medium_Float(Modulus);
return Result;
exception
when Constraint_Error | Numeric_Error =>
Seed := Medium_Integer
((Multiplier * Big_Integer(Seed) + Increment) mod
Modulus);
Result := Medium_Float(Seed) / Medium_Float(Modulus);
return Result;
end Unit_Random;
------------------------------------------------------------------------
separate (Random)
function Random_Int (N : in Medium_Positive)
return Medium_Positive is
Result : Medium_Positive range 1 .. N;
begin -- Random_Int
Result := Medium_Positive(Medium_Float(N) * Unit_Random + 0.5);
return Result;
exception
when Constraint_Error | Numeric_Error =>
return 1;
end Random_Int;
------------------------------------------------------------------------
package body Chop is
task body Stick is
begin
loop
select
accept Pick_Up;
accept Put_Down;
or
terminate;
end select;
end loop;
-- No exception handler is needed here.
end Stick;
end Chop;
------------------------------------------------------------------------
with SPC_Numeric_Types;
with Room;
with Random;
use SPC_Numeric_Types;
package body Phil is
task body Philosopher is
type Life_Time is range 1 .. 100_000;
Who_Am_I : Medium_Natural;
First_Grab : Medium_Natural;
Second_Grab : Medium_Natural;
Meal_Time : Medium_Natural;
Think_Time : Medium_Natural;
begin -- Philosopher
accept Come_To_Life (My_ID : in Medium_Natural;
Chopstick1 : in Medium_Natural;
Chopstick2 : in Medium_Natural) do
Who_Am_I := My_ID;
First_Grab := Chopstick1;
Second_Grab := Chopstick2;
end Come_To_Life;
Room.Head_Waiter.Report_State(Who_Am_I, Breathing);
for Meal in Life_Time loop
Room.Sticks(First_Grab).Pick_Up;
Room.Head_Waiter.Report_State
(Who_Am_I, Got_One_Stick, First_Grab);
Room.Sticks(Second_Grab).Pick_Up;
Room.Head_Waiter.Report_State
(Who_Am_I, Got_Other_Stick, Second_Grab);
Meal_Time := Random.Random_Int(10);
Room.Head_Waiter.Report_State(Who_Am_I, Eating, Meal_Time);
delay Duration(Meal_Time);
Room.Head_Waiter.Report_State(Who_Am_I, Done_Eating);
Room.Sticks(First_Grab).Put_Down;
Room.Sticks(Second_Grab).Put_Down;
Think_Time := Random.Random_Int(10);
Room.Head_Waiter.Report_State
(Who_Am_I, Thinking, Think_Time);
delay Duration(Think_Time);
end loop;
-- No exception handler is needed here.
end Philosopher;
end Phil;
------------------------------------------------------------------------
with SPC_Numeric_Types;
use SPC_Numeric_Types;
with Text_IO;
with Chop;
with Phil;
with Calendar;
pragma Elaborate (Phil);
package body Room is
-- A line-oriented version of the Room package, for line-oriented
-- terminals like IBM 3270's where the user cannot do ASCII
-- screen control.
-- This is the only file in the dining philosophers system that
-- needs changing to use in a line-oriented environment.
-- Michael B. Feldman, The George Washington University,
-- November 1990.
Phils : array (Table_Type) of Phil.Philosopher;
type Phil_Name is (Dijkstra, Texel, Booch, Ichbiah, Stroustrup);
task body Head_Waiter is
T : Medium_Natural;
Start_Time : Calendar.Time;
Phil_Names : constant array (Table_Type) of String (1 .. 18)
:= ("Eddy Dijkstra ", "Putnam Texel ",
"Grady Booch ", "Jean Ichbiah ",
"Bjarne Stroustrup ");
Blanks : constant String := " ";
begin -- Head_Waiter
accept Open_The_Room;
Start_Time := Calendar.Clock;
Phils(1).Come_To_Life(1, 1, 2);
Phils(3).Come_To_Life(3, 3, 4);
Phils(2).Come_To_Life(2, 2, 3);
Phils(5).Come_To_Life(5, 1, 5);
Phils(4).Come_To_Life(4, 4, 5);
loop
select
accept Report_State (Which_Phil : in Table_Type;
State : in Phil.States;
How_Long : in Medium_Natural
:= 0) do
T := Medium_Natural
(Calendar."-"(Calendar.Clock, Start_Time));
Text_IO.Put ("T=" & Medium_Natural'Image(T) & " " &
Blanks(1 .. Positive(Which_Phil)) &
Phil_Names(Which_Phil));
case State is
when Phil.Breathing =>
Text_IO.Put("Breathing");
when Phil.Thinking =>
Text_IO.Put ("Thinking" &
Medium_Natural'Image(How_Long) &
" seconds.");
when Phil.Eating =>
Text_IO.Put ("Eating" &
Medium_Natural'Image(How_Long) &
" seconds.");
when Phil.Done_Eating =>
Text_IO.Put("Yum-yum (burp)");
when Phil.Got_One_Stick =>
Text_IO.Put ("First chopstick" &
Medium_Natural'Image(How_Long));
when Phil.Got_Other_Stick =>
Text_IO.Put ("Second chopstick" &
Medium_Natural'Image(How_Long));
end case; -- State
Text_IO.New_Line;
end Report_State;
or
terminate;
end select;
end loop;
-- An exception handler is not needed here.
end Head_Waiter;
end Room;
------------------------------------------------------------------------
![[Ada Information Clearinghouse]](small_adaic_logo.gif){kind=logo}