Re: Workqueues in Ada

["Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de>]

On Sat, 28 Jul 2007 21:19:10 +0000 (UTC), Wiktor Moskwa wrote:

> On 28.07.2007, Dmitry A. Kazakov <mailbox@dmitry-kazakov.de> wrote:

>> Why? What I don't understand is why removing from a queue should deallocate
>> anything. It might be an artefact of Ada.Containers, but in general case it
>> is not unnecessary. Removing just means that it is the task who will hold
>> the item. Technically the item will be either in no list or in the list of
>> one item long owned by the task. You have one list of items waiting for
>> service and n lists of items being serviced, where n = number of worker
>> tasks. Interlocking is only necessary when you move an item from list to
>> list.
> 
> In GNAT GPL 2007 implementation of Doubly_Linked_Lists an Element is kept
> in a limited record called Node. When Append is called, new Node is
> created and when Delete - Free(Node) is called. Everything happens in
> a default storage pool and is transpated to malloc and free.

Doesn't it have "move X from the list A to the list B?" That should not
have any node allocation / deallocation overhead. In "simple components"
Append, Insert, Prepend have a version which takes the item from another or
same list and places it where required.

> Could you elaborate the concept of having an additional list of items
> per task? When it can be useful? I'm interested.

The concept is that interlocking of the items is list-based. So you have
lists:

   Waiting_For_Service               -- Nobody touches this
   Being_Serviced_By_Worker_1 -- Only the worker 1 has access
   Being_Serviced_By_Worker_2 -- Only the worker 2 has access
   ...

You create items of work only once and then just move them across the
lists. Nobody can do any harm to an item which is not in its list. This is
the standard way OS schedulers and I/O systems are designed.

>> Doubly-linked lists do not have this problem, while removing and inserting
>> overhead is just negligible. You can shuffle items between lists very
>> efficiently.
> 
> If you could write more about using more lists... thanks!

OK, I'll bite, here is a working implementation of. It uses simple
components, but I guess you could do something equivalent with
Ada.Containers, probably it would require adding a list to each worker and
using move-service-move instead of remove-service-append. Anyway:

with Ada.Finalization;
with Generic_Doubly_Linked;

package Scheduler is
--
-- Job -- Abstract piece of work
--
   type Job is
      abstract new Ada.Finalization.Controlled with
         null record;
   procedure Do_It (Work : in out Job) is abstract;
   
   package Job_List is new Generic_Doubly_Linked (Job'Class);
   use Job_List.Doubly_Linked;
--
-- Worker -- A task doing jobs
--
   task type Worker is
   end Worker;
--
-- Submit -- A new job for processing
--
   procedure Submit (Work : Item);
--
-- Print_Me -- A concrete job, prints some text
--
   type Print_Me (Length : Natural) is new Job with record
      Text : String (1..Length);
   end record;
   procedure Do_It (Work : in out Print_Me);
   function Have_To_Print (Text : String) return Item;   

end Scheduler;
---------------------------------
package body Scheduler is

   protected Waiting_Queue is
      entry Get_For_Service (Work : out Item);
      procedure Submit (Work : Item);
   private
      Queue : List;
   end Waiting_Queue;

   protected body Waiting_Queue is
      entry Get_For_Service (Work : out Item)
         when Queue /= null is
      begin
         Work := Item (Queue);  -- The first in the list
         Remove (Queue, Work); -- Remove it from there
      end Get_For_Service;
      
      procedure Submit (Work : Item) is
      begin
         Append (Queue, Work); -- Add to the end
      end Submit;
      
   end Waiting_Queue;

   task body Worker is
      This : Item;
   begin
      loop
         Waiting_Queue.Get_For_Service (This);
         -- Now we are holding This, so be careful with exceptions,
         -- the item must back to the queue in all cases
         begin
            This.Do_It;
               -- Item was serviced, return it back
            Waiting_Queue.Submit (This);
         exception
            when others =>
               Waiting_Queue.Submit (This);
               raise;
         end;
      end loop;
   end Worker;

   procedure Submit (Work : Item) is
   begin
      Waiting_Queue.Submit (Work);
   end Submit;

   procedure Do_It (Work : in out Print_Me) is
   begin
      Put_Line (Work.Text);
   end Do_It;

   function Have_To_Print (Text : String) return Item is
   begin
      return
         new Print_Me'
             (  Job
             with
                Length => Text'Length,
                Text   => Text
             );
   end Have_To_Print;

end Scheduler;
------------------------------
Now a test program:

with Scheduler;  use Scheduler;

procedure Test_Scheduler is
   W1 : Worker;
   W2 : Worker;
   W3 : Worker;
   W4 : Worker;
   W5 : Worker;

begin
   Submit (Have_To_Print ("The"));
   Submit (Have_To_Print ("quick"));
   Submit (Have_To_Print ("brown"));
   Submit (Have_To_Print ("fox"));
   Submit (Have_To_Print ("jumps"));
   Submit (Have_To_Print ("over"));
   Submit (Have_To_Print ("the"));
   Submit (Have_To_Print ("lazy"));
   Submit (Have_To_Print ("dog"));
   -- This will never end!
end Test_Scheduler;

Here 5 workers are printing 9 different texts. GNAT implementation of
Put_Line is interlocked, so you would not see a mess of characters, but
properly formed lines in some arbitrary order.

Observe that the program will never end. You should add some on-exiting
stuff, which I have omitted to simplify the program. Upon exiting you would
terminate workers and clean the queue up.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de