This example uses tasks with entries, hierarchical packages, and a protected
object
for a little spice.
Starting at the lowest level of abstraction, we have the specification for
the package
defining the simple tasks:
-----------------------------------------------------------------------
-- Simple repetitive task type
-----------------------------------------------------------------------
package Simple_Tasks is
task type Simple is
Entry Start;
Entry Stop;
end Simple;
end Simple_Tasks;
------------------------
-- The package body for Simple_Tasks contains the protected object as well
as
-- the completion of task type Simple.
with Ada.Text_Io;
package body Simple_Tasks is
-- Description/Usage: The protected object Counter maintains a
-- local counter for the tasks. Each task will call the procedure
-- Take_Number to obtain a value indicating its relative temporal
-- position.
--
-- Many instances of the task type Simple may be created, but there
-- will only be one instance of the protected object Counter.
-- All instances of the task type Simple must call the Take_Number
-- procedure after their Start entry is called.
--
protected Counter is
procedure Take_Number(Count : out Positive);
private
Tally : Positive := 1;
end Counter;
protected body Counter is
-- This procedure delivers the current tally value then
-- increments the tally value. It is assumed that this
-- procedure will not be called often enough to attempt to
-- exceed Positive'Last.
-- The exception Constraint_Error will be raised by the
-- runtime system should this ever occur, terminating the
-- program in a most ungraceful manner.
procedure Take_Number(Count : out Positive) is
begin
Count := Tally;
Tally := Tally + 1;
end Take_Number;
end Counter;
------------
-- Simple --
------------
task body Simple is
My_Count : Positive;
begin
-- Wait for some other task to call this task's Start entry.
accept Start;
Counter.Take_Number(My_Count);
Ada.Text_Io.Put_Line("Task" & Positive'Image(My_Count) &
" started.");
-- Suspend this task until some other task calls this task's
-- Stop entry.
accept Stop;
Ada.Text_Io.Put_Line("Task" & Positive'Image(My_Count) &
" stopped.");
end Simple;
end Simple_Tasks;
-----------------------
-- Next we have a child package of the package Simple_Tasks.
-- This child package defines a very simple linked list manipulation
-- mechanism for Simple_Tasks.
------------------------
-----------------------------------------------------------------------
-- List package for the simple tasks
--
-- This package is a child of the Simple_Tasks package, extending the
-- capabilities of that package without altering the parent package.
-----------------------------------------------------------------------
package Simple_Tasks.Lists is
-- Description/Usage: Preliminary (incomplete) definition of a
-- list type for tasks.
type List is private;
--------------------------------------------------------------------
-- Adds another task to the list of tasks
--------------------------------------------------------------------
procedure Lengthen(The_List : in out List);
--------------------------------------------------------------------
-- Stops all the tasks on the list and deallocates the memory used
-- by those tasks
--------------------------------------------------------------------
procedure Halt_Tasks(Task_List : in out List);
private
-- Description/Usage: forward declaration of the list element type
type List_Element;
-- Description/Usage: Completion of the definition of the List type.
type List is access List_Element;
-- Description/Usage: Completion of the definition of the
-- List_Element type. Being private, this type is not accessable
-- to the users of this package. It is used only within the
-- body of this package.
type List_Element is record
Thread : Simple;
Next : List := Null;
end record;
end Simple_Tasks.Lists;
-------------------------------------------
-- Of course, this package needs a body too.
------------------------------------------
with Ada.Unchecked_Deallocation;
package body Simple_Tasks.Lists is
----------------
-- Halt_Tasks --
----------------
procedure Halt_Tasks (Task_List : in out List) is
procedure Free is new Ada.Unchecked_Deallocation(
Object => List_Element,
Name => List);
Temp : List;
begin
while Task_List /= null loop
Temp := Task_List;
Task_List := Task_List.Next;
-- Call the Stop entry for the task.
Temp.Thread.Stop;
-- Make sure the task is terminated before deallocating it.
while not Temp.Thread'Terminated loop
delay 0.001;
end loop;
-- Deallocate the List_Element containing the task
Free(Temp);
end loop;
end Halt_Tasks;
--------------
-- Lengthen --
--------------
procedure Lengthen (The_List : in out List) is
Temp : List;
begin
-- simple linked list operation. Add the first element
-- if the list is empty
if The_List = null then
-- Allocate the new List_Element
The_List := new List_Element;
-- Call the Start entry for task in the newly allocated
-- List_Entry
The_List.Thread.Start;
else
-- Add to the end of the list if it is not empty.
Temp := The_List;
-- This operation gets longer as the number of tasks
-- increases.
while Temp.Next /= null loop
Temp := Temp.Next;
end loop;
-- Allocate the new List_Element
Temp.Next := new List_Element;
-- Call the Start entry for task in the newly allocated
-- List_Entry
Temp.Next.Thread.Start;
end if;
end Lengthen;
end Simple_Tasks.Lists;
-----------------------------------
-- Finally, we have the procedure used to test the
-- Simple_Tasks.Lists package.
-----------------------------------
-----------------------------------------------------------------------
-- PROCEDURE NAME: Count_Tasks
--
-- PURPOSE: This procedure is the driver for testing the task list
-- operations defined in the package Simple_Tasks.Lists.
--
-----------------------------------------------------------------------
with Simple_Tasks.Lists; use Simple_Tasks.Lists;
with Ada.Text_Io;
procedure Count_Tasks is
-- Description/Usage: A list of tasks, starting with an
-- empty list.
--
My_List : List;
begin
-- Create a number of tasks and add them to the list of tasks
for Threads in 1..60 loop
Lengthen(My_List);
end loop;
-- Allow all tasks in the list to have their turn executing
delay 0.0;
-- Stop all tasks on the list and deallocate the list elements
Halt_Tasks(My_List);
Ada.Text_Io.Put_Line("All tasks stopped and deallocated.");
end Count_Tasks;
|