Dealing with Linked Lists of Tasks

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;