1. -- 
  2. --  Uwe R. Zimmer, Australia, September 2011 
  3. -- 
  4.  
  5. with Ada.Task_Identification;     use Ada.Task_Identification; 
  6. with Ada.Text_IO;                use Ada.Text_IO; 
  7. with Ada.Unchecked_Deallocation; use Ada; 
  8.  
  9. with Id_Generator_Sequential; 
  10. with Id_Generator_Concurrent; 
  11. with Sub_Ranges; 
  12.  
  13. procedure Instantiate_Tasks_With_Id is 
  14.  
  15.    --  Structures to declare tasks in arrays of distinct ranges 
  16.  
  17.    type Task_Range is new Positive range 1 .. 15; 
  18.  
  19.    package Task_Ranges is new Sub_Ranges (Task_Range, 5); 
  20.    use Task_Ranges; 
  21.  
  22.    subtype Task_Range_1 is Task_Range range Range_First (1) .. Range_Last (1); 
  23.    subtype Task_Range_2 is Task_Range range Range_First (2) .. Range_Last (2); 
  24.    subtype Task_Range_3 is Task_Range range Range_First (3) .. Range_Last (3); 
  25.    subtype Task_Range_4 is Task_Range range Range_First (4) .. Range_Last (4); 
  26.    subtype Task_Range_5 is Task_Range range Range_First (5) .. Range_Last (5); 
  27.  
  28.    package Id_Generator_Range_2 is new Id_Generator_Concurrent (Task_Range_2); 
  29.    use Id_Generator_Range_2; 
  30.  
  31.    package Id_Generator_Range_3 is new Id_Generator_Sequential (Task_Range_3); 
  32.  
  33.    --  Required task declarations for different forms of Id provision 
  34.  
  35.    task type Task_Waiting_For_Id_On_Entry is 
  36.       entry Provide_Id (Id : Task_Range_1); 
  37.    end Task_Waiting_For_Id_On_Entry; 
  38.  
  39.    task type Task_Fetching_Own_Id_Itself; 
  40.  
  41.    task type Task_with_Default_Id_Discriminator (This_Task_Id : Task_Range_3 := Id_Generator_Range_3.Set_Id); 
  42.  
  43.    task type Task_with_Id_Discriminator (This_Task_Id : Task_Range_4); -- need to be allocated on heap or by individual task declaration 
  44.  
  45.    task type Task_Using_System_Task_Id; 
  46.  
  47.    --  Additional infrastructure to handle heap allocated tasks 
  48.  
  49.    type Task_with_Set_Id_Discriminator_P is access Task_with_Id_Discriminator; 
  50.    procedure Free_Task_with_Set_Id_Discriminator is new Unchecked_Deallocation (Object => Task_with_Id_Discriminator, Name => Task_with_Set_Id_Discriminator_P); 
  51.  
  52.    --  Task bodies for all of the above 
  53.  
  54.    task body Task_Waiting_For_Id_On_Entry is 
  55.  
  56.       This_Task_Id : Task_Range_1; 
  57.  
  58.    begin 
  59.       accept Provide_Id (Id : Task_Range_1) do 
  60.          This_Task_Id := Id; 
  61.       end Provide_Id; 
  62.  
  63.       Put_Line ("Task " & Task_Range'Image (This_Task_Id) & " was waiting for its Id"); 
  64.    end Task_Waiting_For_Id_On_Entry; 
  65.  
  66.    -- 
  67.  
  68.    task body Task_Fetching_Own_Id_Itself is 
  69.  
  70.       This_Task_Id : Task_Range_2; 
  71.  
  72.    begin 
  73.       Generator.Read_Id (This_Task_Id); 
  74.  
  75.       Put_Line ("Task " & Task_Range'Image (This_Task_Id) & " fetched its Id"); 
  76.    end Task_Fetching_Own_Id_Itself; 
  77.  
  78.    -- 
  79.  
  80.    task body Task_with_Default_Id_Discriminator is 
  81.  
  82.    begin 
  83.       Put_Line ("Task " & Task_Range'Image (This_Task_Id) & " was instantiated with a default Id function"); 
  84.    end Task_with_Default_Id_Discriminator; 
  85.  
  86.    -- 
  87.  
  88.    task body Task_with_Id_Discriminator is 
  89.  
  90.    begin 
  91.       Put_Line ("Task " & Task_Range'Image (This_Task_Id) & " was instantiated with an Id"); 
  92.    end Task_with_Id_Discriminator; 
  93.  
  94.    -- 
  95.  
  96.    task body Task_Using_System_Task_Id is 
  97.  
  98.    begin 
  99.       Put_Line ("Task using system task id: '" & Image (Current_Task) & "'"); 
  100.    end Task_Using_System_Task_Id; 
  101.  
  102.    --  Declaring arrays of all task types 
  103.  
  104.    Tasks_Waiting_For_Id       : array (Task_Range_1) of Task_Waiting_For_Id_On_Entry; 
  105.    Tasks_Fetching_Id          : array (Task_Range_2) of Task_Fetching_Own_Id_Itself;        -- Id's do not need to match array indices ! 
  106.    Tasks_Id_Discriminator     : array (Task_Range_3) of Task_with_Default_Id_Discriminator; -- Id's do not need to match array indices ! 
  107.    Tasks_Id_Discriminator_P   : array (Task_Range_4) of Task_with_Set_Id_Discriminator_P; 
  108.    Tasks_Using_System_Task_Id : array (Task_Range_5) of Task_Using_System_Task_Id; 
  109.  
  110. begin 
  111.  
  112.    --  Two of the task declation types require an explicit provision of Ids: 
  113.  
  114.    for Task_Ix in Tasks_Waiting_For_Id'Range loop 
  115.       Tasks_Waiting_For_Id (Task_Ix).Provide_Id (Task_Ix); 
  116.    end loop; 
  117.  
  118.    for Task_Ix in Tasks_Id_Discriminator_P'Range loop 
  119.       Tasks_Id_Discriminator_P (Task_Ix) := new Task_with_Id_Discriminator (Task_Ix); 
  120.    end loop; 
  121.  
  122.    --  Tasks on heap marked to be deallocated on termination: 
  123.  
  124.    for Task_Ix in Tasks_Id_Discriminator_P'Range loop 
  125.       Free_Task_with_Set_Id_Discriminator (Tasks_Id_Discriminator_P (Task_Ix)); 
  126.    end loop; 
  127.  
  128. end Instantiate_Tasks_With_Id;