--
--  Uwe R. Zimmer, Australia, September 2011
--

with Ada.Task_Identification;     use Ada.Task_Identification;
with Ada.Text_IO;                use Ada.Text_IO;
with Ada.Unchecked_Deallocation; use Ada;

with Id_Generator_Sequential;
with Id_Generator_Concurrent;
with Sub_Ranges;

procedure Instantiate_Tasks_With_Id is

   --  Structures to declare tasks in arrays of distinct ranges

   type Task_Range is new Positive range 1 .. 15;

   package Task_Ranges is new Sub_Ranges (Task_Range, 5);
   use Task_Ranges;

   subtype Task_Range_1 is Task_Range range Range_First (1) .. Range_Last (1);
   subtype Task_Range_2 is Task_Range range Range_First (2) .. Range_Last (2);
   subtype Task_Range_3 is Task_Range range Range_First (3) .. Range_Last (3);
   subtype Task_Range_4 is Task_Range range Range_First (4) .. Range_Last (4);
   subtype Task_Range_5 is Task_Range range Range_First (5) .. Range_Last (5);

   package Id_Generator_Range_2 is new Id_Generator_Concurrent (Task_Range_2);
   use Id_Generator_Range_2;

   package Id_Generator_Range_3 is new Id_Generator_Sequential (Task_Range_3);

   --  Required task declarations for different forms of Id provision

   task type Task_Waiting_For_Id_On_Entry is
      entry Provide_Id (Id : Task_Range_1);
   end Task_Waiting_For_Id_On_Entry;

   task type Task_Fetching_Own_Id_Itself;

   task type Task_with_Default_Id_Discriminator (This_Task_Id : Task_Range_3 := Id_Generator_Range_3.Set_Id);

   task type Task_with_Id_Discriminator (This_Task_Id : Task_Range_4); -- need to be allocated on heap or by individual task declaration

   task type Task_Using_System_Task_Id;

   --  Additional infrastructure to handle heap allocated tasks

   type Task_with_Set_Id_Discriminator_P is access Task_with_Id_Discriminator;
   procedure Free_Task_with_Set_Id_Discriminator is new Unchecked_Deallocation (Object => Task_with_Id_Discriminator, Name => Task_with_Set_Id_Discriminator_P);

   --  Task bodies for all of the above

   task body Task_Waiting_For_Id_On_Entry is

      This_Task_Id : Task_Range_1;

   begin
      accept Provide_Id (Id : Task_Range_1) do
         This_Task_Id := Id;
      end Provide_Id;

      Put_Line ("Task " & Task_Range'Image (This_Task_Id) & " was waiting for its Id");
   end Task_Waiting_For_Id_On_Entry;

   --

   task body Task_Fetching_Own_Id_Itself is

      This_Task_Id : Task_Range_2;

   begin
      Generator.Read_Id (This_Task_Id);

      Put_Line ("Task " & Task_Range'Image (This_Task_Id) & " fetched its Id");
   end Task_Fetching_Own_Id_Itself;

   --

   task body Task_with_Default_Id_Discriminator is

   begin
      Put_Line ("Task " & Task_Range'Image (This_Task_Id) & " was instantiated with a default Id function");
   end Task_with_Default_Id_Discriminator;

   --

   task body Task_with_Id_Discriminator is

   begin
      Put_Line ("Task " & Task_Range'Image (This_Task_Id) & " was instantiated with an Id");
   end Task_with_Id_Discriminator;

   --

   task body Task_Using_System_Task_Id is

   begin
      Put_Line ("Task using system task id: '" & Image (Current_Task) & "'");
   end Task_Using_System_Task_Id;

   --  Declaring arrays of all task types

   Tasks_Waiting_For_Id       : array (Task_Range_1) of Task_Waiting_For_Id_On_Entry;
   Tasks_Fetching_Id          : array (Task_Range_2) of Task_Fetching_Own_Id_Itself;        -- Id's do not need to match array indices !
   Tasks_Id_Discriminator     : array (Task_Range_3) of Task_with_Default_Id_Discriminator; -- Id's do not need to match array indices !
   Tasks_Id_Discriminator_P   : array (Task_Range_4) of Task_with_Set_Id_Discriminator_P;
   Tasks_Using_System_Task_Id : array (Task_Range_5) of Task_Using_System_Task_Id;

begin

   --  Two of the task declation types require an explicit provision of Ids:

   for Task_Ix in Tasks_Waiting_For_Id'Range loop
      Tasks_Waiting_For_Id (Task_Ix).Provide_Id (Task_Ix);
   end loop;

   for Task_Ix in Tasks_Id_Discriminator_P'Range loop
      Tasks_Id_Discriminator_P (Task_Ix) := new Task_with_Id_Discriminator (Task_Ix);
   end loop;

   --  Tasks on heap marked to be deallocated on termination:

   for Task_Ix in Tasks_Id_Discriminator_P'Range loop
      Free_Task_with_Set_Id_Discriminator (Tasks_Id_Discriminator_P (Task_Ix));
   end loop;

end Instantiate_Tasks_With_Id;