This is a simple example of tasking and protected types.
-----------------------------------------------------------------------------
-- Factory Package
-- Defines a set of task types and communication buffers for the simulation
-- of a factory using "Just In Time" manufacturing techniques.
-----------------------------------------------------------------------------
generic
type Products is (<>);
package Factory is
type Buffers is array(Positive range <>) of Products;
protected type Production_Buffer (Buf_Size : Positive) is
entry Add_Product(Item : in Products);
entry Get_Product(Item : out Products);
private
Buffer : Buffers(1..Buf_Size);
Oldest : Positive := 1;
Newest : Positive := 1;
Count : Natural := 0;
end Production_Buffer;
type Buffer_Access is access Production_Buffer;
task type Producer is
entry Start(Downstream : in Buffer_Access);
entry Halt;
end Producer;
task type Consumer is
entry Start(Upstream : in Buffer_Access);
entry Halt;
end Consumer;
end Factory;
with Ada.Text_Io;
package body Factory is
type Counter is array(Products) of Natural;
--------------
-- Consumer --
--------------
task body Consumer is
Next_Unit : Products;
Conbon : Buffer_Access;
Next_Delay : Duration;
Got_Product : Boolean;
Product_Counts : Counter := (others => 0);
begin
accept Start (Upstream : in Buffer_Access) do
Conbon := Upstream;
end;
Consumption:
loop -- Keep on working until shut down
select
Conbon.Get_Product(Next_Unit);
Got_Product := True;
or
delay 0.05; -- Detect upstream buffer empty
Ada.Text_Io.Put_Line("Upstream buffer empty. Waiting.");
Got_Product := False;
end select;
if Got_Product then
Next_Delay := Duration(Products'Pos(Next_Unit)) * 0.26;
Ada.Text_Io.Put_Line("Consumed " & Products'Image(Next_Unit));
Product_Counts(Next_Unit) := Product_Counts(Next_Unit) + 1;
end if;
select
accept Halt;
Ada.Text_Io.Put_Line("Products Consumed:");
for Index in Product_Counts'range loop
Ada.Text_Io.Put_Line(Products'Image(Index) &
" :" &
Natural'Image(Product_Counts(Index)));
end loop;
exit Consumption;
or
delay Next_Delay; -- Time required to consume a product
end select;
end loop Consumption;
end Consumer;
--------------
-- Producer --
--------------
task body Producer is
Conbon : Buffer_Access;
Next_Delay : Duration;
begin
accept Start(Downstream : in Buffer_Access) do
Conbon := Downstream;
end;
Production_Loop:
loop -- Keep on producing until factory is shut down.
for Unit in Products'range loop
Next_Delay := Duration(Products'Pos(Unit)) * 1.3;
-- delay Next_Delay; -- Time required to produce a unit.
select
Conbon.Add_Product(Unit);
or
delay 0.03; -- Detect full downstream buffer
Ada.Text_Io.Put_Line("Downstream Buffer full." &
" Producer Waiting.");
Conbon.Add_Product(Unit);
end select;
Ada.Text_Io.Put_Line("Produced " & Products'Image(Unit));
select
accept Halt;
exit Production_Loop;
or
delay 0.5; -- Takes 0.5 seconds to produce a unit
end select;
end loop;
end loop Production_Loop;
end Producer;
-----------------------
-- Production_Buffer --
-----------------------
protected body Production_Buffer is
-----------------
-- Add_Product --
-----------------
entry Add_Product (Item : in Products) when Count < Buf_Size is
begin
Buffer(Newest) := Item;
if Newest < Buf_Size then
Newest := Newest + 1;
else
Newest := 1;
end if;
Count := Count + 1;
end Add_Product;
-----------------
-- Get_Product --
-----------------
entry Get_Product (Item : out Products) when Count > 0 is
begin
Item := Buffer(Oldest);
if Oldest < Buf_Size then
Oldest := Oldest + 1;
else
Oldest := 1;
end if;
Count := Count - 1;
end Get_Product;
end Production_Buffer;
end Factory;
-----------------------------------------------------------------------------
-- Factory Manager
-- The Factory_manager procedure defines the factory products,
-- starts the factory, and shuts down the factory.
-----------------------------------------------------------------------------
with Factory;
with Ada.Text_Io;
procedure Factory_Manager is
type Production_Units is (Sonic_Screwdriver,
Stem_Bolt,
Phase_Modulator,
Warp_Convertor,
Subspace_Transducer);
package Synthesizer is new Factory(Production_Units);
use Synthesizer;
Buffer : Buffer_Access := new Production_Buffer(3);
Federation : Producer;
Ferengi_Alliance : Consumer;
begin
Federation.Start(Downstream => Buffer);
Ada.Text_Io.Put_Line("Federation starting production.");
delay 5.0; -- The Ferengis are a little slow tapping into the
-- Federation production system today.
Ferengi_Alliance.Start(Upstream => Buffer);
Ada.Text_Io.Put_Line("Ferengi Alliance starting consumption.");
delay 60.0; -- The manager takes a while to recognize the situation
Federation.Halt;
Ada.Text_Io.Put_Line("Federation production halted.");
delay 1.0; -- The manager must be a Ferengi sympathizer.
Ferengi_Alliance.Halt;
Ada.Text_Io.Put_Line("Ferengi Alliance leaving sector.");
end Factory_Manager;