Re: Private or public task ?

["Hibou57 (Yannick Duchêne)" <yannick_duchene@yahoo.fr>]

The source I'm referring to in the previous post :

with Ada.Text_IO;
-- For the service provided by the
-- Output_Server package.
with Ada.Finalization;
-- For the Ticket_Type implementation.

procedure Test is

   package Text_IO renames Ada.Text_IO;

   package Output_Server is
      -- Provides a server which outputs text on
      -- the standard output stream, in an atomic
      -- maner. Ths purpose of this package is
      -- to experiment and the better implementation
      -- for such a requirement, would have been to
      -- simply use a protected type. This is an
      -- experiment to do the same with a task
      -- instead.

      type Ticket_Type is limited private;
      -- Any request to Instance.Put must be
      -- made providing a ticket. The Instance task
      -- will live at least as long as a ticket
      -- is alive in scope and as long as there is
      -- no more ticket alive.

      task Instance is
         entry Put
           (Ticket : in Ticket_Type;
            Text   : in String;
            Number : in Natural);
         -- Print Text follow by the image of Number
         -- on a new line on the standard output. Keep
         -- in mind this is just an experiment example.
         --
         -- The normal way to complete a task in Ada
         -- (not to be confused with task termination),
         -- is to either have executed all of its task
         -- body [ARM 9.3(5)] or to be blocked on select
         -- statement with an opened terminate alternative
         -- [ARM 9.3(6/1)], that is, if there is no other
         -- opened accept statement matching a queued
         -- request [ARM 9.7.1(16)] (providing the task
         -- body is built around a Select Accept block).
         --
         -- The "trouble" with this, is that this will
         -- be completed as soon there will be no more
         -- queued request pending. Indeed, the task
         -- semantic refer to actual state and in some
         -- way to the previous state, but cannot refer
         -- to any futur or potentially futur state.
         --
         -- We want to complete the task, only when we
         -- will know no futur request could come.
         -- A specification may be to tell we are in
         -- such a case when no more client task are
         -- alive (when they are either all completed
         -- or terminated).
         --
         -- So we need a way to know which tasks are
         -- clients of this server task. This is the
         -- purpose of the ticket of Ticket_Type which
         -- comes as a required parameter of the Put
         -- entry.
      end Instance;

   private

      -- There use to be an implementation where
      -- the server task exposed an Acquire and
      -- Release entry, which client were to invok
      -- to declare they are client and later no
      -- more client of the server task. To
      -- be more secure, it was later decided to
      -- manage it automatically via the
      -- Initialize/Finalize capabilities of a
      -- Limited_Controlled type.
      --
      -- Clients do not invok any more Acquire
      -- and then later Release, they just have
      -- to own a ticket, which automatically
      -- do the stuff as its initialization
      -- and later finalization part. This
      -- is more safe and less error prone
      -- on the client side.

      type Ticket_Type is
         limited
         new Ada.Finalization.Limited_Controlled
         with null record;

      overriding procedure Initialize
         (Ticket : in out Ticket_Type);
      -- Initialization of a ticket register
      -- a client.

      overriding procedure Finalize
         (Ticket : in out Ticket_Type);
      -- Finalization of a ticket unregister
      -- a client.

   end Output_Server;

   package body Output_Server is

      -- Ticket_Type is a private type of the
      -- Output_Server package. It needs to
      -- inform the Instance task (the server
      -- task) when a ticket is entering into
      -- existance and when it is later no
      -- more alive.
      --
      -- Unfortunately, we cannot provide Acquire
      -- and Release entries which will be only
      -- accessible to the implementation of
      -- Ticket_Type.
      --
      -- So, we need another way the Ticket_Type
      -- and the Instance to be able to communicate
      -- privately. This is done via the following
      -- Clients_Counter protected object.

      protected Clients_Counter is
         procedure Acquire;
         procedure Release;
         function  Count return Natural;
         function  Has_Started return Boolean;
      private
         -- These two members use the postffix _Value
         -- to avoid a name clash with the two
         -- corresponding functions.
         Count_Value : Natural := 0;
         Has_Started_Value : Boolean := False;
         -- The number of registered clients is first
         -- zero. The Instance task completes as soon
         -- as there is no queued request and the number
         -- of living registered clients is zero.
         --
         -- But the start time is a special case : we
         -- are waiting for client to register. So
         -- we will not consider the first zero value,
         -- and will only take care of a zero value
         -- when it will go down to zero.
         --
         -- This is the purpose of Has_Started_Value.
         --
         -- Thus, the Instance task can request to
         -- both Count and Has_Started status.
      end Clients_Counter;

      protected body Clients_Counter is

         procedure Acquire is
         begin
            Has_Started_Value := True;
            Count_Value := Count_Value + 1;
            Text_IO.Put_Line
              ("Acquire: Count is now " &
               Natural'Image (Count_Value) &
               "and Has_Started is now " &
               Boolean'Image (Has_Started_Value));
            -- Log Clients_Counter activities for
            -- debuging purpose.
         end Acquire;

         procedure Release is
         begin
            Count_Value := Count_Value - 1;
            Text_IO.Put_Line
              ("Release: Count is now " &
               Natural'Image (Count_Value));
            -- Log Clients_Counter activities for
            -- debuging purpose.
         end Release;

         function Has_Started return Boolean is
         begin
            -- {Location #1}: if this log
            -- statement is removed, then
            -- the Instance task blocked
            -- indefinitely at location #2.
            Text_IO.Put_Line
              ("Has_Started: returned " &
               Boolean'Image (Has_Started_Value));
            -- Log Clients_Counter activities for
            -- debuging purpose.
            return Has_Started_Value;
         end Has_Started;

         function Count return Natural is
         begin
            Text_IO.Put_Line
              ("Count: returned " &
               Natural'Image (Count_Value));
            -- Log Clients_Counter activities for
            -- debuging purpose.
            return Count_Value;
         end Count;

      end Clients_Counter;

      overriding procedure Initialize
         (Ticket : in out Ticket_Type)
      -- Initialization of a ticket register
      -- a client.
      is
      begin
         Clients_Counter.Acquire;
      end Initialize;

      overriding procedure Finalize
         (Ticket : in out Ticket_Type)
      -- Finalization of a ticket unregister
      -- a client.
      is
      begin
         Clients_Counter.Release;
      end Finalize;

      task body Instance
      is
      begin
         while True loop
            select
               accept Put
                 (Ticket : in Ticket_Type;
                  Text   : in String;
                  Number : in Natural)
               do
                  pragma Unreferenced (Ticket);
                  -- The sole use of the ticket is
                  -- to require the client to actually
                  -- own a ticket.
                  Text_IO.Put_Line
                    (Text &
                     " " &
                     Natural'Image (Number));
               end Put;
            or
               -- {Location #2}: this work find
               -- as long a there is a log statement
               -- at location #1. If this statement
               -- is removed, then the task never
               -- reach its terminate alternative.
               when
                 (Clients_Counter.Has_Started) and
                 (Clients_Counter.Count = 0)
                  =>
                  terminate;
            end select;
         end loop;
      end Instance;

   end Output_Server;

   -- Shortcuts for better readability.

   subtype Ticket_Type is
      Output_Server.Ticket_Type;

   procedure Put
     (Ticket : in Ticket_Type;
      Text   : in String;
      Number : in Natural)
   renames
      Output_Server.Instance.Put;
   -- Keep in mind it's a task entry.

   -- Now comes three simple task.
   -- Al have the same layout. The
   -- first one is the sole commented
   -- one.

   task First_Task;
   task body First_Task
   is
      Ticket : Ticket_Type;
      -- Automatically register this
      -- task as client when we enter the
      -- scope and unregister this task
      -- when the task is terminated.
   begin
      for Index in 1..4 loop
         Put
           (Ticket,
            "This is First_Task, passing number ",
            Index);
         -- Remember Put is a request to the
         -- Output_Server.Instance.Put entry.
      end loop;
   end First_Task;

   -- Second task : same thing.

   task Second_Task;
   task body Second_Task
   is
      Ticket : Ticket_Type;
   begin
      for Index in 1..7 loop
         Put
           (Ticket,
            "This is Second_Task, passing number",
            Index);
      end loop;
   end Second_Task;

   -- Third task : same story.

   task Third_Task;
   task body Third_Task
   is
      Ticket : Ticket_Type;
   begin
      for Index in 1..5 loop
         Put
           (Ticket,
            "This is Third_Task, passing number ",
            Index);
      end loop;
   end Third_Task;

begin
   null;
   -- Nothing there, all is done in tasks.
   -- The application terminates when the last
   -- task terminates.
   --
   -- The tasks which will be started by the environment
   -- task are : Output_Server.Instance, First_Task,
   -- Second_Task and Third_Task.
end Test;