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.  
  8. procedure Link_Tasks is 
  9.  
  10.    --  Structures to declare tasks in arrays of distinct ranges 
  11.  
  12.    type Task_Range is mod 5; 
  13.  
  14.    type Messages is new Natural; 
  15.  
  16.    --  Required task declarations for different forms of linking tasks 
  17.  
  18.    task type Task_Linked_By_Global_Array is 
  19.       entry Link_To             (This_Task, 
  20.                                  Next_Task : Task_Range); -- assumes access to a global array of tasks 
  21.       entry Synchronous_Message (Message   : Messages); --  just for illustration 
  22.    end Task_Linked_By_Global_Array; 
  23.  
  24.    type Task_Linked_By_Reference; -- incomplete declaration so that we can use a reference to itself in its actual declaration below 
  25.    type Task_Linked_By_Reference_P is access all Task_Linked_By_Reference; 
  26.  
  27.    task type Task_Linked_By_Reference is 
  28.       entry Link_To             (This_Task : Task_Range; 
  29.                                  Next_Task : Task_Linked_By_Reference_P); -- tasks can now be allocated anywhere and individually 
  30.       entry Synchronous_Message (Message   : Messages); --  just for illustration 
  31.    end Task_Linked_By_Reference; 
  32.  
  33.    --  Declaring arrays of all task types 
  34.  
  35.    Tasks_Linked_By_Global_Array : array (Task_Range) of Task_Linked_By_Global_Array; 
  36.    Tasks_Linked_By_Reference    : array (Task_Range) of aliased Task_Linked_By_Reference; 
  37.  
  38.    --  Task bodies for all of the above 
  39.  
  40.    task body Task_Linked_By_Global_Array is 
  41.  
  42.       This_Task_Ix, 
  43.       Next_Task_Ix : Task_Range; 
  44.  
  45.    begin 
  46.       accept Link_To (This_Task, Next_Task : Task_Range) do 
  47.          This_Task_Ix := This_Task; 
  48.          Next_Task_Ix := Next_Task; 
  49.       end Link_To; 
  50.  
  51.       declare 
  52.          The_Last_Word : Messages := Messages (Task_Range'First); 
  53.  
  54.          procedure Send_Word (Word : in out Messages) is 
  55.  
  56.          begin 
  57.             Word := Word + Messages (This_Task_Ix); 
  58.             Put_Line ("Task " & Task_Range'Image (This_Task_Ix) & " sends    (index) :" & Messages'Image (Word)); 
  59.             Tasks_Linked_By_Global_Array (Next_Task_Ix).Synchronous_Message (Word); 
  60.          end Send_Word; 
  61.  
  62.       begin 
  63.          if This_Task_Ix = Task_Range'First then 
  64.             Send_Word (The_Last_Word); 
  65.             accept Synchronous_Message (Message : Messages) do 
  66.                The_Last_Word := Message; 
  67.             end Synchronous_Message; 
  68.             Put_Line ("Task " & Task_Range'Image (This_Task_Ix) & " received (index) :" & Messages'Image (The_Last_Word)); 
  69.          else 
  70.             accept Synchronous_Message (Message : Messages) do 
  71.                The_Last_Word := Message; 
  72.             end Synchronous_Message; 
  73.             Put_Line ("Task " & Task_Range'Image (This_Task_Ix) & " received (index) :" & Messages'Image (The_Last_Word)); 
  74.             Send_Word (The_Last_Word); 
  75.          end if; 
  76.       end; 
  77.  
  78.    end Task_Linked_By_Global_Array; 
  79.  
  80.    -- 
  81.  
  82.    task body Task_Linked_By_Reference is 
  83.  
  84.       This_Task_Ix : Task_Range; 
  85.       Next_Task_P  : Task_Linked_By_Reference_P; 
  86.  
  87.    begin 
  88.       accept Link_To (This_Task : Task_Range; Next_Task : Task_Linked_By_Reference_P) do 
  89.          This_Task_Ix := This_Task; 
  90.          Next_Task_P  := Next_Task; 
  91.       end Link_To; 
  92.  
  93.       declare 
  94.          The_Last_Word : Messages := Messages (Task_Range'First); 
  95.  
  96.          procedure Send_Word (Word : in out Messages) is 
  97.  
  98.          begin 
  99.             Word := Word + Messages (This_Task_Ix); 
  100.             Put_Line ("Task " & Task_Range'Image (This_Task_Ix) & " sends    (reference) :" & Messages'Image (Word)); 
  101.             Next_Task_P.all.Synchronous_Message (Word); 
  102.          end Send_Word; 
  103.  
  104.       begin 
  105.          if This_Task_Ix = Task_Range'First then 
  106.             Send_Word (The_Last_Word); 
  107.             accept Synchronous_Message (Message : Messages) do 
  108.                The_Last_Word := Message; 
  109.             end Synchronous_Message; 
  110.             Put_Line ("Task " & Task_Range'Image (This_Task_Ix) & " received (reference) :" & Messages'Image (The_Last_Word)); 
  111.          else 
  112.             accept Synchronous_Message (Message : Messages) do 
  113.                The_Last_Word := Message; 
  114.             end Synchronous_Message; 
  115.             Put_Line ("Task " & Task_Range'Image (This_Task_Ix) & " received (reference) :" & Messages'Image (The_Last_Word)); 
  116.             Send_Word (The_Last_Word); 
  117.          end if; 
  118.       end; 
  119.  
  120.    end Task_Linked_By_Reference; 
  121.  
  122.    -- 
  123.  
  124. begin 
  125.  
  126.    --  Linking up the tasks in a ring topology: 
  127.  
  128.    for Task_Ix in Tasks_Linked_By_Global_Array'Range loop 
  129.       Tasks_Linked_By_Global_Array (Task_Ix).Link_To (Task_Ix, Task_Ix + 1); 
  130.    end loop; 
  131.  
  132.    for Task_Ix in Tasks_Linked_By_Reference'Range loop 
  133.       Tasks_Linked_By_Reference (Task_Ix).Link_To (Task_Ix, Tasks_Linked_By_Reference (Task_Ix + 1)'Access); 
  134.    end loop; 
  135. end Link_Tasks;