How to have a background task (GNAT, Windows)

I am trying to start a background task on Windows. Here is my code:

package body Process_Task is
   task The_Task is
      entry Process (Source : String; Destination : String);
   end The_Task;

   task body The_Task is
   begin
      accept Process (Source : String; Destination : String) do
         for I in 1..10 loop
            Ada.Text_IO.Put_Line ("Process " & Integer'Image(I));
            delay 0.2;
         end loop;
      end;
   end The_Task;

   procedure Process (Source : String; Destination : String) is
   begin
      Ada.Text_IO.Put_Line ("Start");
      The_Task.Process (Source, Destination);
      Ada.Text_IO.Put_Line ("End");
   end Process;
end Process_Task;

I would like The_Task.Process (Source, Destination); to launch the process and return immediately. But here, I have to wait the 10 numbers before the print of End. Curiously, The_Task yield the CPU at accept (if not there would be a dead lock), but not at delay.

(Source and Destination are for future use).

Ok, so the stuff there is the rendezvous.
This is where the tasks involved are synchronized — so you’re holding the client and server together in your loop.

The above, subtly different, will do what you’re expecting.

3 Likes

Thank you, that’s fine.

Since the actual processing needs Source and Destination, I have to write

accept Process (Source : String; Destination : String) do
  S := Unbounded_String (Source);
  D := Unbounded_String (Destination);
end Process;
Do_The_Actual_Procces (S, D);

I would find it easier to put the actual proces in the do block… but if that’s blocking…

That’s exactly the definition of rendezvous in Ada: the calling task is blocked while what’s in the accept statement is executed.

1 Like

As noted, during a rendezvous, the calling task is suspended, and you have seen how to minimize that suspension. Another approach is to not use rendezvous at all, instead having the tasks communicate through a protected object:

type Src_Dest_Pair is record
   Source      : Unbounded_String;
   Destination : Unbounded_String;
end record;

package Q_IF is new Ada.Containers.Synchronized_Queue_Interfaces (Element_Type => Src_Dest_Pair);
package Queues is new Ada.Containers.Unbounded_Synchronized_Queues (Queue_Interfaces => Q_IF);

Queue : Queues.Queue;

task Processor;

task body Processor is
   Info : Src_Dest_Pair;
begin -- Processor
   Queue.Dequeue (Element => Info);

   Count : for I in 1..10 loop
      Ada.Text_IO.Put_Line (Item => "Processor " & I'Image);

      delay 0.2;
   end loop Count;
end Processor;

procedure Process (Source : String; Destination : String) is
   -- Empty
begin -- Process
   Ada.Text_IO.Put_Line (Item => "Start");
   Queue.Enqueue (New_Item => (Source      => To_Unbounded_String (Source),
                               Destination => To_Unbounded_String (Destination) ) );
   Ada.Text_IO.Put_Line (Item => "End");
end Process;

Well, it requires time measurement. Using a queue requires copying and waiting for an event. Rendezvous passes parameters by reference and you have an opportunity to validate data since the call is synchronous.

In the scenario producer/consumer queues are used to avoid blocking the producer paying with memory for that and also with CPU overhead as you are using Unbounded_Strings shuffled around, which involves the memory heap. So for overall performance as I said one have to measure.

In my use case, the producer is a GUI that launch the task. Then the process is not started at a high frequency and the process is about dealing a whole directory (far longer than managing heap information). But I will prefer not to have the UI frozen during the process. (The process updates the GUI).

The Queue option seems adequate but I guess a little bit more complex.

Well scanning a directory tree just one level deep may take literally hours. The GUI should show a progress indicator, e.g. the notorious Windows explorer “green band of death.”

Here’s the thing, the rendezvous is synchronization-for-data-transfer.
What your mental model is saying is that the rendezvous (acceptend) is the [sub]task… the mismatch here will cause troubles for you. — I would recommend using a task to implement some protocol a few times to disabuse that notion and train yourself on how they actually work.

Example, given a process where you need a client doing (A, then B [same client]) or C, repeatedly would be done with:

Task Example is
  Entry A;
  Entry B;
  Entry C;
  Entry Done;
End Example;

Task Body Example is
  Finished : Boolean := False;
Begin
  Loop
    Exit when Finished;
    Select
        Accept A;
        Accept B;
    or
        Accept C;
    or
        Accept Done;
        Finished:= True;
    End Select;
  End Loop;
End Example;

The above implements the above-stated protocol — with the addition of Done for signaling shutdown. (Note, the reason that A then B works here is because of the unstated assumption that client code will call entry-A, then entry-B, not ‘randomly’ spamming A or B.)

Now, continuing on (after you’ve implemented a few sequence-protocols, let’s add in data-transfer:

Task Example_2 is
  Entry Put( Value : in            Natural );
  Entry Get( Value :    out access Natural );
End Example_2;

Task Body Example_2 is
  Has_Value : Boolean := False;
  The_Value : Natural;
Begin
  Loop
    Select
        accept Put( Value : in Natural ) do
            Has_Value:= True;
            The_Value:= Value;
        end Put;
    or
        accept Get( Value :    out access Natural ) do
            Value:= (if Has_Value then 
                        New Natural'( The_Value ) 
                     else Null);
            Has_Value:= False;
        end Get;
    End Select;
  End Loop;
End Example_2;

And, if you’re going to be using unconstrained types, like String, you’re going to have to use a by-parts approach:

Task Example_3 is
  Entry Put( Value : in     String  );
  Entry Get( Value :    out Natural );
  Entry Get( Value :    out String  );
End Example_3;

Task Body Example_3 is
  Package Word_List is new Ada.Containers.Indefinite_Vectors
  ( Element_Type => String, Index_Type => Positive );

  Items : Word_List.Vector;
  Index : Natural:= Natural'First;
Begin
  Loop
    Select
      accept Get( Value :    out Natural ) do
        Value:= (if Index not in 1..Items.Length then 0 else Items(Index)'Length);
      end Get;
      accept Get( Value :    out String  ) do
        Value:= (if Index not in Positive then "" else Items(Index));
      end Get;
    or
      accept  Put( Value : in     String  ) do
        Items.Append( Value );
        Index:= 
      end Put;
    End Select;
  End Loop;
End Example_3;

Function Example_Usage return String is
  Length : Natural;
Begin
  -- In order to retrieve the value, we need two rendezvous:
  -- First, to retrieve the length; and after generating a string of that length,
  -- Second, to populate that string with that data.
  Example_3.Get( Length );
  Return Result : String(1..Length) do
    Example_3.Get( Result );
  End return;
End Example_Usage;

The reason that you need to split things this way is because, with an out parameter (or in out) you cannot [re-]set the length of said parameter; to work around this, you get the length you need, then pass in the appropriately-sized array. — For explanations on why you have to do this, see my posts on the threads on strings/string-initialization: here and here, but the TL;DR of it is this: given a constrained value, you cannot re-set the constraints thereon; you may return results of an unconstrained subtype because the value thereof provides the constraints thereon.

1 Like

If you can get away with missed/overwritten updates then you could use the Mailbox pattern:

with Ada.Strings.Unbounded;
use  Ada.Strings.Unbounded;
with Ada.Text_IO;

procedure Background_Task is
   task Mailbox is
      entry Put (Source      : in String;
                 Destination : in String); --   or perhaps a record with Source/Destination components?
      entry Get (Source : out Unbounded_String;
                 Destination : out Unbounded_String);
   end Mailbox;
   task body Mailbox is
      Src : Unbounded_String;
      Dest : Unbounded_String; --   can also combine these in one line
      New_Batch : Boolean := False;
   begin
      loop
         select
            accept Put (Source      : in String;
                        Destination : in String) do
               Src := To_Unbounded_String (Source);
               Dest := To_Unbounded_String (Destination);
               New_Batch := True;
            end;
         or
            when New_Batch =>
               accept Get (Source      : out Unbounded_String;
                           Destination : out Unbounded_String) do
                  Source := Src;
                  Destination := Dest;
                  New_Batch := False;
               end;
         end select;
      end loop;
   end Mailbox;
   
   task The_Task;
   task body The_Task is
      Src : Unbounded_String;
      Dest : Unbounded_String;
   begin
      loop
         Mailbox.Get (Src, Dest);
         --   run logic using Src, Dest
      end loop;
   end The_Task;
   
   procedure Process (Source : String; Destination : String) is
   begin
      Ada.Text_IO.Put_Line ("Start");
      Mailbox.Put (Source, Destination);
      Ada.Text_IO.Put_Line ("End");
   end Process;
begin
   loop
      Process ("", "");
   end loop;
end Background_Task;

You could guard Mailbox.Put too but that would naturally result in a blocking Process.

1 Like