Re: passing messages between the tasks

[Shark8 <OneWingedShark@gmail.com>]

On 10/14/2014 3:08 PM, compguy45@gmail.com wrote:
> What i am trying to do is something like this....code from above...
>
> 3
>    4 procedure SomeProcedure is
>    5
>    6 task type lamp is
>    7    entry reset(id : Integer);
>    8 end lamp;
>    9
>   10 lamps : array (1..6) of lamp;
>   11
>   12    task body lamp is
>   13    begin
>   14       Put_Line("Body of task lamp");
>   15       accept reset(id : Integer) do
>   16         put("inside reset");
>   17         put(id);
>   18         New_Line;
>   19       end reset;
>   20       delay 4.0;
>   21    put("after accept");
>   22    end lamp;
>   23
>   24 begin
>   25    lamps(1).reset(id => 1);
>   26    lamps(2).reset(id => 2);
>   27 end SomeProcedure;
>
> I am trying to figure out how to do following....
> have say main tasks call reset on say lamps(3).reset....
> Then lamp(3) would call reset on lamps(2) and lamps(1) and wait
> then someone lamps(2) and lamps(1) when they done with reset
> would somehow let lamp(3) know about it....
>
>Is this possible to do...?

Hm, I think it is -- but it's a bit on the convoluted side; when I saw 
your first post asking the same question I wrote up some code as a bit 
of a proof of concept. It kind-of works, I could probably get it a lot 
better if (A) I had more time, and/or (B) I had more experience w/ 
tasks. {Tasks are a great feature; I just haven't had occasion to use 
them all that often.}

Anyway; here's what I got for making a network of tasks -- which is, 
essentially, what you're asking about:

-----------------
--  NODES.ADS  --
-----------------

Package Nodes is
    type Node_Interface is task interface;


    type Node_Access is access all Node_Interface'Class;
    type Node_List is array(Positive range <>) of Node_Access;

    Function "XOR" (Left : Node_List; Right : Positive) return Node_List is
      ( Left(Left'First..Natural'Pred(Right)) & 
Left(Natural'Succ(Right)..Left'Last) );
    Function "XOR" (Left : Node_List; Right : Positive) return not null 
access Node_List is
      ( New Node_List'(Left XOR Right) );


    Function Null_List return not null access Node_List is
       ( New Node_List'(2..1 => <>) );

    Function Make_Network(Size : Natural) return not null access Node_List;

    task type Node( Neighbors : not null access Node_List ) is
         new Node_Interface with
    end Node;

End Nodes;


-----------------
--  NODES.ADB  --
-----------------
with
Ada.Task_Identification,
Unchecked_Conversion,
      System.Address_To_Access_Conversions,
      System.Address_Image,
Ada.Text_IO;

Package body Nodes is
    Package Node_Pointers is new
      System.Address_To_Access_Conversions(Object => Node);

    Function Convert is new Unchecked_Conversion
      (Source => Node_Pointers.Object_Pointer,  Target => Node_Access);

    Function Convert( A : System.Address ) return Node_Access is
      ( Convert(Node_Pointers.To_Pointer( A )) );

    task body Node is
       use Ada.Task_Identification, System;

       New_Line : Constant String:= ASCII.CR & ASCII.LF;


       Function Line_1 return String is
         ("Task " & Image(Current_Task) & ": " & Neighbors'Length'Img
              & ASCII.HT & Address_Image(Node'Access.All'Address)
          & New_Line
         );

       Function Line_2( Input : Node_List ) return String is
         (if Input'Length = 0 then ""
          else
              ASCII.HT & Address_Image(Input(Input'First).All'Address) & 
New_Line
            & Line_2( Input(Input'First+1..Input'Last) )
         );

       Function Line_2 return String is
          ( Line_2(Node.Neighbors.All) );
       Function Line_3 return String is
         ("Done.");
    begin
       Ada.Text_IO.Put_Line( Line_1 & Line_2 & Line_3 );
       null;
    end Node;


    Function Make_Network(Size : Natural) return Node_List;
    Function Make_Network(Size : Natural) return not null access 
Node_List is
       ( New Node_List'(Make_Network(size)) );


    Function Make_Network(Size : Natural) return Node_List is
       subtype Full_Range       is Positive Range 1..Size;
       subtype Full_Node_List   is Node_List(Full_Range);

       subtype Constrained_List is Node_List(1..Size-1);
       subtype Constrained_Node is Node( Neighbors => new 
Constrained_List );
       Type Task_Array is array (Full_Range) of aliased Constrained_Node;

       Package TAP is new System.Address_To_Access_Conversions(Task_Array);

       Generic
       Package Incrementation is
          Procedure Increment;
          Function  Increment return Full_Range;
       End Incrementation;

       Package body Incrementation is
          Index : Full_Range:= Full_Range'First;
          Function  Increment return Full_Range is
          begin
             Return  Result : constant Full_Range:= Index do
                Increment;
             end return;
          end Increment;

          Procedure Increment is
          begin
             Index:= (if Index = Full_Range'Last then Full_Range'First
                      else Full_Range'Succ( Index ));
          end Increment;
       end Incrementation;


       Function Make_Nodes(Task_List : out Task_Array) return Node_List is

          Package Inc is new Incrementation;
          Use Inc;

          List : constant Full_Node_List:=
            ( others => Convert(Task_List(Increment)'Address) );

             Function Get_List return Constrained_List is
             begin
                Return Result : Constrained_List:= List xor Increment;
             end;

             List_List : constant Array(Full_Range) of Constrained_List:=
                            (others => Get_List);

          Function Make_Tasks( List : Full_Node_List ) return Task_Array is
             Subtype Actual_Node is
               Node(Neighbors => New Node_List'(List_List(Increment)));
             Type Task_Cluster is Array(Full_Range) of Actual_Node;

             Function Tasks return Task_Cluster is
             begin
                Return result: Task_Cluster;
             end;

             Function Convert is new Unchecked_Conversion
               (Source => Task_Cluster, Target => Task_Array);
          begin
             Return Convert( Tasks );
          end Make_Tasks;



       Begin
          return Result : Full_Node_List := List do

             declare
                pragma Warnings( Off );
                K : Task_Array:= Make_Tasks(result)
                  with Address => Task_List'Address;
                pragma Warnings( On );
             begin
                null;
             end;
--              for Index in Full_Range loop
--                 declare
--                    N : Node renames Task_List(Index);
--                    A : constant System.Address := N'Address;
--                    pragma Warnings( Off );
--                    T : Node(Neighbors => New 
Node_List'(List_List(Index)))
--                      with Address => A;
--                    pragma Warnings( On );
--                 begin
--                    null;
--                 end;
--              end loop;

          end return;
       End Make_Nodes;



       Tasks : aliased Task_Array with Import;

    begin
       Return Make_Nodes(Tasks);
    end Make_Network;

End Nodes;


----------------
--  TEST.ADB  --
----------------
With
Nodes;

procedure Test is
    use all type Nodes.Node_List;

    Children_1 : not null access Nodes.Node_List:= Nodes.Make_Network(3);
    Master   : Nodes.Node( Neighbors =>
                           Children_1
                           --Nodes.Null_List
                          );

begin
    null;
end Test;