Structure of the multitasking server

Structure of the multitasking server

[Maciej Sobczak]

Hi all,

Imagine a server with fixed number of worker tasks. There is no queue
of jobs and jobs are immediately passed to one of the tasks that is
currently idle. There is a separate task (or just the main one) that
provides jobs for worker tasks.

I am concerned with the proper structure of objects - I mean in the
sense of recommended Ada practice.
Obviously there is a need for some shared resource where the
requesting task will put the job and from where the worker task will
pick it up.

This is more or less what I came up with, where the "channel" is a
single processing pipeline:

   type Worker_State is (Idle, Ready, Working);

   protected type Channel_State is
      procedure Post (J : in Job_Type);
      entry Get_Job (J : out Job_Type);
      function Busy return Boolean;
   private
      State : Worker_State := Idle;
      Job_To_Do : Job_Type;
   end Channel_State;

   protected body Channel_State is

      procedure Post (J : in Job_Type) is
      begin
         if State /= Idle then
            raise Program_Error;
         end if;

         Job_To_Do := J;
         State := Ready;
      end Post;

      entry Get_Job (J : out Job_Type) when State = Ready is
      begin
         J := Job_To_Do;
         State := Working;
      end Get_Job;

      function Busy return Boolean is
      begin
         return State /= Idle;
      end Busy;

   end Channel_State;

   type Channel;
   task type Worker_Task (Ch : access Channel);

   type Channel is record
      State : Channel_State;
      Worker : Worker_Task (Channel'Access);
   end record;

   task body Worker_Task is
      Job : Job_Type;
   begin
      loop
         Ch.all.Get_Job (Job);

         --  do the job ...

      end loop;
   end Worker_Task;

   Max_Channels : constant := 5;

   Channels : array (1 .. Max_Channels) of Channel;

My question is whether this is what a seasoned Ada programmer would
do.
Initially I tried to have two separate arrays, one for jobs and one
for worker tasks, but I found it difficult to link workers with their
respective jobs. After bundling them together in a single record that
is referenced from the task it worked and I actually find it
structured better.

The main task after constructing a job object finds some channel where
the worker task is not busy and posts the job to its shared state
component:

   loop
      Job := ...

      Found_Worker := False;
      for I in Channels'Range loop
         if not Channels (I).State.Busy then
            Channels (I).State.Post (Job);
            Found_Worker := True;
            exit;
         end if;
      end loop;

      if not Found_Worker then
         --  all pipelines are busy,
         --  but the overflow handling is not shown...
      end if;
   end loop;

All this works fine, but my question considers the choice of language
constructs and idioms.

--
Maciej Sobczak * www.msobczak.com * www.inspirel.com

Database Access Library for Ada: www.inspirel.com/soci-ada

Re: Structure of the multitasking server

[Jean-Pierre Rosen]

Maciej Sobczak a �crit :
> Hi all,
> 
> Imagine a server with fixed number of worker tasks. There is no queue
> of jobs and jobs are immediately passed to one of the tasks that is
> currently idle. There is a separate task (or just the main one) that
> provides jobs for worker tasks.
[...]

Why not simply use a rendezvous?
Each worker has an entry Get_Job:

     task body Worker_Task is
        Job : Job_Type;
     begin
        loop
           Get_Job (Job);

           --  do the job ...

        end loop;
     end Worker_Task;

and the server is simply (assuming Servers is an array of Worker_Task):

     loop
        Job := ...

        Found_Worker := False;
        for I in Servers'Range loop
           select
              Server (I).Get_Job (Job);
              Found_Worker := True;
              exit;
           else
              -- This server is busy
              null;
           end select;
        end loop;

        if not Found_Worker then
           --  all pipelines are busy,
           --  but the overflow handling is not shown...
        end if;
     end loop;
-- 
---------------------------------------------------------
            J-P. Rosen (rosen@adalog.fr)
Visit Adalog's web site at http://www.adalog.fr

Re: Structure of the multitasking server

[Dmitry A. Kazakov]

On Fri, 19 Sep 2008 15:34:00 +0200, Jean-Pierre Rosen wrote:

> Maciej Sobczak a �crit :
>> 
>> Imagine a server with fixed number of worker tasks. There is no queue
>> of jobs and jobs are immediately passed to one of the tasks that is
>> currently idle. There is a separate task (or just the main one) that
>> provides jobs for worker tasks.
> [...]
> 
> Why not simply use a rendezvous?
> Each worker has an entry Get_Job:
> 
>      task body Worker_Task is
>         Job : Job_Type;
>      begin
>         loop
>            Get_Job (Job);

You mean:

accept Get_Job (Requested : Job_Type) do
   Job := Requested;
end Get_Job;

>         end loop;
>      end Worker_Task;
> 
> and the server is simply (assuming Servers is an array of Worker_Task):
> 
>      loop
>         Job := ...
> 
>         Found_Worker := False;
>         for I in Servers'Range loop
>            select
>               Server (I).Get_Job (Job);
>               Found_Worker := True;
>               exit;
>            else
>               -- This server is busy
>               null;
>            end select;
>         end loop;
> 
>         if not Found_Worker then
>            --  all pipelines are busy,
>            --  but the overflow handling is not shown...
>         end if;
>      end loop;

This scheme requires some additional efforts in order to maintain the list
of idle workers.

I would use an inverse one, which is much simpler:

with Ada.Text_IO;  use Ada.Text_IO;

   type Job_Type is (Quit, Run);
   type Job (Kind : Job_Type := Quit) is null record;
   task type Worker;
   task Server is
      entry Get (Work : out Job);
   end Server;

   task body Server is
      Request : Job;
      Workers : array (1..5) of Worker;
   begin
      loop
            -- Get a job to do
         Request := (Kind => Run);
            -- Wait for a worker to come
         accept Get (Work : out Job) do
            Work := Request;
         end Get;
      end loop;

      -- Terminating workers
      for Index in Workers'Range loop
         Request := (Kind => Quit);
         accept Get (Work : out Job) do
            Work := Request;
         end Get;
      end loop;
   end Server;

   task body Worker is
      Work : Job;
   begin
      loop
         Server.Get (Work);
         case Work.Kind is
            when Quit => exit;
            when Run  => Put_Line ("Doing things");
         end case;
      end loop;
      Put_Line ("I am done");
   end Worker;

Note that task termination is usually a difficult problem in Ada. You
should pay an attention to this early. (The "terminate" alternative is
unusable in 80% cases.) In the solution above a special job type is used to
kill the worker.

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

Re: Structure of the multitasking server

[Maciej Sobczak]

On 19 Wrz, 19:02, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
wrote:

> Note that task termination is usually a difficult problem in Ada. You
> should pay an attention to this early.

No problem with that. With separate protected object (instead of
rendezvous) it is enough to do this:

   protected type Channel_State is
      procedure Post (J : in Job_Type);
      procedure Finish;
      entry Get_Job (J : out Job_Type; Finished : out Boolean);
      function Busy return Boolean;
   private
      State : Worker_State := Idle;
      Job_To_Do : Job_Type;
      Should_Finish : Boolean := False;
   end Channel_State;

and later in the worker task:

      loop
         Ch.all.Get_Job (Job, Finished);
         exit when Finished;

         --  do the job ...

      end loop;


There is no need to introduce any special type of job ("poison pill").
Above, the job space is not polluted with task lifetime management
concepts - these should be kept separate.

--
Maciej Sobczak * www.msobczak.com * www.inspirel.com

Database Access Library for Ada: www.inspirel.com/soci-ada

Re: Structure of the multitasking server

[Dmitry A. Kazakov]

On Sun, 21 Sep 2008 10:30:37 -0700 (PDT), Maciej Sobczak wrote:

> On 19 Wrz, 19:02, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
> wrote:
> 
>> Note that task termination is usually a difficult problem in Ada. You
>> should pay an attention to this early.
> 
> No problem with that. With separate protected object (instead of
> rendezvous) it is enough to do this:

Of course there is a problem because conditional and timed entry calls may
not contain a "terminate" alternative. This is another reason why a
protected object might be a poor choice. But the way you used protected
object looks like a design noise. Technically you just replaced a
rendezvous queue with a protected entry queue. Instead of just server and
workers, you have server, workers, channels and management stuff. Very
OO-ish in the negative sense of this word.

The second problem which adds complexity is server to worker 1-n
communication. Should be n-1 worker to server, simpler (classic
client-server) and more efficient too.

Due to complexity you have overlooked to make a channel idle again after a
job is done. You also have overlooked to add a "Shut_Down" state in order
to finalize workers: four channel states instead of just none. And note,
that the type Channel cannot call to the procedure Finish to set Shut_Down
from its Finalize (if it were controlled). That is because Worker is a
component of. The thing will hang up on channel destruction. 

> There is no need to introduce any special type of job ("poison pill").

Job carries the parameters of a worker. You used it too, under the name
Job_Type.

> Above, the job space is not polluted with task lifetime management
> concepts - these should be kept separate.

You have polluted it with the procedure Finish, that has to be called
outside the worker tasks.

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

Re: Structure of the multitasking server

[Maciej Sobczak]

On 21 Wrz, 21:24, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
wrote:
> On Sun, 21 Sep 2008 10:30:37 -0700 (PDT), Maciej Sobczak wrote:

> > No problem with that. With separate protected object (instead of
> > rendezvous) it is enough to do this:
>
> Of course there is a problem because conditional and timed entry calls may
> not contain a "terminate" alternative.

They don't have to. Again:

      entry Get_Job (J : out Job_Type; Finished : out Boolean);

They have *no choice* but to get the Finished flag. Well, they don't
have to react to it, but that seems to be very easy to spot in the
code review or during the data flow analysis.

> But the way you used protected
> object looks like a design noise. Technically you just replaced a
> rendezvous queue with a protected entry queue.

The fact that this replacement is so obvious is exactly the reason why
rendezvous as a language-level mechanism is nothing but a syntax
sugar.

> Instead of just server and
> workers

There is never "just server and workers". There are also jobs, queues
(even if implicit) and lifetime management (your "poison pills").

> you have server, workers, channels and management stuff.

Because it *is* there anyway.
Trying to hide it? What about the following: in my version the main
task (the one that invents jobs) can give the job to the worker task
when it is still working on the previous one, so that the main task
need not be blocked and can go on inventing more jobs. In other words,
main task and worker tasks need not wait for each other. This is not
obvious from the state transitions that I've shown, but can be
trivially implemented this way, without any massive modification of
the tasks themselves:

   protected type Channel_State is
      procedure Post (J : in Job_Type);
      procedure Finish;
      entry Get_Job (J : out Job_Type; Finished : out Boolean);
      function Can_Accept_New_Job return Boolean;
   private
      Job_Pending : Boolean := False;
      Should_Finish : Boolean := False;
      Job_To_Do : Job_Type;
   end Channel_State;

This code makes it easy to go to real queue with capacity > 1.

This is not so easy in your version with rendezvous, where the main
task has to always *wait* until some of the worker will be willing to
pick up the new job (that's the whole point of rendezvous). Obviously,
there are fewer opportunities for concurrency in your version.
What would you have to do to have this increased concurrency in your
version? Would you still claim it to be simpler?

> The second problem which adds complexity is server to worker 1-n
> communication. Should be n-1 worker to server, simpler (classic
> client-server) and more efficient too.

I'd prefer producer + queue + N consumers. Still a protected object in
the middle.

> Due to complexity you have overlooked to make a channel idle again after a
> job is done.

Yes, I have overlooked it, but now I would not make it this way. I
would make it as describe above, to benefit from the increased
concurrency.

> And note,
> that the type Channel cannot call to the procedure Finish to set Shut_Down
> from its Finalize (if it were controlled).

That's right and this is why I asked here about different design
options.

> > There is no need to introduce any special type of job ("poison pill").
>
> Job carries the parameters of a worker. You used it too, under the name
> Job_Type.

But in my case the Job_Type need not contain the special "poison"
value. Let's say that the Job_Type is a matrix that has to be
reversed. There is no place for the "poison" value in the matrix
itself, so the Job_Type would need to be extended (a record with
additional flag, perhaps?) to cover it, but then the pollution of the
type would be very explicit.

> > Above, the job space is not polluted with task lifetime management
> > concepts - these should be kept separate.
>
> You have polluted it with the procedure Finish, that has to be called
> outside the worker tasks.

I did not pollute the Job_Type (the matrix to be reversed), only the
Channel_State - which is there exactly for everything that is related
to managing the pipeline.

--
Maciej Sobczak * www.msobczak.com * www.inspirel.com

Database Access Library for Ada: www.inspirel.com/soci-ada

Re: Structure of the multitasking server

[Dmitry A. Kazakov]

On Sun, 21 Sep 2008 14:27:13 -0700 (PDT), Maciej Sobczak wrote:

> On 21 Wrz, 21:24, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
> wrote:
>> On Sun, 21 Sep 2008 10:30:37 -0700 (PDT), Maciej Sobczak wrote:
> 
>>> No problem with that. With separate protected object (instead of
>>> rendezvous) it is enough to do this:
>>
>> Of course there is a problem because conditional and timed entry calls may
>> not contain a "terminate" alternative.
> 
> They don't have to. Again:
> 
>       entry Get_Job (J : out Job_Type; Finished : out Boolean);

Which is a bad pattern because it propagates task termination requests to
an entry point of some object (or another task) which usually have little
or nothing to do with the task termination issue.

I don't like an extra output parameter, it is error-prone. Therefore I used
a special value of Job_Type. There also exists a third variant with an
exception propagation. (Note that an exception from an rendezvous
propagates on both sides)

This all is a matter of taste, because the (poor) pattern is same: the
knowledge about caller's termination is moved to the callee.

>> you have server, workers, channels and management stuff.
> 
> Because it *is* there anyway.
> Trying to hide it? What about the following: in my version the main
> task (the one that invents jobs) can give the job to the worker task
> when it is still working on the previous one, so that the main task
> need not be blocked and can go on inventing more jobs.

This is a very different task. You didn't say that you wanted to queue
jobs. Anyway there is little sense to queue jobs to busy workers. A better
design would be:

   Server --> Scheduler <-- Worker

The jobs are queued to the scheduler. Workers ask it for jobs to do.
Scheduler could be a protected object or a task. Depending on the nature of
the jobs source, Server and Scheduler can be merged (see below).

> This is not so easy in your version with rendezvous, where the main
> task has to always *wait* until some of the worker will be willing to
> pick up the new job (that's the whole point of rendezvous).

You *have* to wait, or else you must drop jobs.

Queueing jobs postpones the problem but that by no means solves it. If
workers are incapable to process the jobs, the server must wait for them.
The only reason why job queueing might become necessary is a need to make
the server asynchronously working. (Remember our recent discussion?
Buffering = wasting resources, unless decouples.)

Anyway it is no problem in my design. Use selective accept (RM 9.7.1):

   select
      when not Empty (Queue)  => accept Get (Work : out Job) do
         ... -- A worker is here to get a job from the FIFO
      end Get;
   or when not Full (Queue) => accept Put (Work : out Job) do
         ... -- A new job is to queue into the FIFO
      end Put;
   or when Full (Queue) => delay Time_Out;
      ... -- Go to hell with your jobs!
   end select;

> Obviously,
> there are fewer opportunities for concurrency in your version.
> What would you have to do to have this increased concurrency in your
> version? Would you still claim it to be simpler?

Certainly yes. If I wished to collect jobs at the server I would just add a
FIFO of jobs there, like above.

>> The second problem which adds complexity is server to worker 1-n
>> communication. Should be n-1 worker to server, simpler (classic
>> client-server) and more efficient too.
> 
> I'd prefer producer + queue + N consumers. Still a protected object in
> the middle.

What you describe is my design (the queue is held by the producer).Your
design was:

   producer + N queues of size 1 + N consumers

It is not a problem to me to split the producer into server and scheduler.
I object mainly to moving *parts* of the scheduler (as protected objects)
into the consumers. It makes no sense.

>>> There is no need to introduce any special type of job ("poison pill").
>>
>> Job carries the parameters of a worker. You used it too, under the name
>> Job_Type.
> 
> But in my case the Job_Type need not contain the special "poison"
> value.

See above. You can use either of three variants with my design. This is an
independent issue.

> Let's say that the Job_Type is a matrix that has to be
> reversed. There is no place for the "poison" value in the matrix
> itself, so the Job_Type would need to be extended (a record with
> additional flag, perhaps?) to cover it, but then the pollution of the
> type would be very explicit.

If it were large objects, I would not use copying anyway. So it would
become a referential object moving around. These would have enough place
for "poison". Further, don't forget that Ada has variant records.

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

Re: Structure of the multitasking server

[Maciej Sobczak]

On 22 Wrz, 10:12, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
wrote:

> >       entry Get_Job (J : out Job_Type; Finished : out Boolean);
>
> Which is a bad pattern because it propagates task termination requests to
> an entry point of some object (or another task) which usually have little
> or nothing to do with the task termination issue.

How is the special job any different in this aspect? It has exactly
the same properties, just implicitly.

> I don't like an extra output parameter, it is error-prone. Therefore I used
> a special value of Job_Type.

In what way is a special value less error-prone than a separate flag?

> There also exists a third variant with an
> exception propagation.

This assumes rendezvous.

> This all is a matter of taste, because the (poor) pattern is same: the
> knowledge about caller's termination is moved to the callee.

In the version with protected objects the entity that triggers
termination might be different from the one that invents job.
In your version these different responsibilities are mixed.

> > What about the following: in my version the main
> > task (the one that invents jobs) can give the job to the worker task
> > when it is still working on the previous one, so that the main task
> > need not be blocked and can go on inventing more jobs.
>
> This is a very different task. You didn't say that you wanted to queue
> jobs.

And this is exactly the advantage of separate protected object - I
didn't have to state all aspects and I was free to invent the part
with queues later on. This flexibility is not provided by rendezvous,
which would then require massive rework.

> Anyway there is little sense to queue jobs to busy workers.

There is a lot of sense. In particular, in my version the task that
invents jobs is never blocked on interactions with workers. This is a
big advantage, because such a blocking would disturb its own
interactions with the environment and reduce its responsiveness.
In your version with rendezvous the task that invents jobs has to
block and during that time it cannot react to the events that drive it
(keyboard input, network transmission, etc.).

> A better
> design would be:
>
>    Server --> Scheduler <-- Worker
>
> The jobs are queued to the scheduler. Workers ask it for jobs to do.
> Scheduler could be a protected object or a task.

Isn't it what I have proposed?

> You *have* to wait, or else you must drop jobs.

Which might be a perfectly legal handling policy.
Or the main task could promptly reject requests so that clients can
back off or try to find another, less busy server.

> Anyway it is no problem in my design. Use selective accept (RM 9.7.1):
>
>    select
>       when not Empty (Queue)  => accept Get (Work : out Job) do
>          ... -- A worker is here to get a job from the FIFO
>       end Get;
>    or when not Full (Queue) => accept Put (Work : out Job) do
>          ... -- A new job is to queue into the FIFO
>       end Put;
>    or when Full (Queue) => delay Time_Out;
>       ... -- Go to hell with your jobs!
>    end select;

But this looks like part of a separate task and the third branch still
causes someone else to block.

--
Maciej Sobczak * www.msobczak.com * www.inspirel.com

Database Access Library for Ada: www.inspirel.com/soci-ada

Re: Structure of the multitasking server

[Dmitry A. Kazakov]

On Mon, 22 Sep 2008 05:47:13 -0700 (PDT), Maciej Sobczak wrote:

> On 22 Wrz, 10:12, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
> wrote:
> 
>>> � � � entry Get_Job (J : out Job_Type; Finished : out Boolean);
>>
>> Which is a bad pattern because it propagates task termination requests to
>> an entry point of some object (or another task) which usually have little
>> or nothing to do with the task termination issue.
> 
> How is the special job any different in this aspect? It has exactly
> the same properties, just implicitly.

It is not, as I said the pattern is same.

>> I don't like an extra output parameter, it is error-prone. Therefore I used
>> a special value of Job_Type.
> 
> In what way is a special value less error-prone than a separate flag?

Not a flag, it is a special value. I have used a discriminant, which would
then control a variant record.

>> There also exists a third variant with an
>> exception propagation.
> 
> This assumes rendezvous.

Nope. An exception can be propagated from the entry body or rendezvous.
Here is my example with exceptions (a complete program):

with Ada.Text_IO;  use Ada.Text_IO;

procedure Test_Server is
   Time_To_Die : exception;
   type Job is null record;
   task type Worker;
   task Server is
      entry Get (Work : out Job);
   end Server;

   task body Server is
      Request : Job;
      Workers : array (1..5) of Worker;
   begin
      for Times in 1..7 loop
         -- Get a job to do

         -- Wait for a worker to come
         accept Get (Work : out Job) do
            Work := Request;
         end Get;
      end loop;
      -- Terminating workers
      for Index in Workers'Range loop
         begin
            accept Get (Work : out Job) do
               raise Time_To_Die;
            end Get;
         exception
            when Time_To_Die => null;
         end;
      end loop;
   end Server;

   task body Worker is
      Work : Job;
   begin
      loop
         Server.Get (Work);
         Put_Line ("Doing things");
      end loop;
   exception
      when Time_To_Die => Put_Line ("I am done");
   end Worker;
begin
   null;
end Test_Server;

>> This all is a matter of taste, because the (poor) pattern is same: the
>> knowledge about caller's termination is moved to the callee.
> 
> In the version with protected objects the entity that triggers
> termination might be different from the one that invents job.
> In your version these different responsibilities are mixed.

It does not work. You cannot selectively call to multiple entries of a
protected object anyway. Then again, termination should be triggered by
task finalization, this the only "right way." All others are more or less
nasty workarounds. This is the point. So long it is not either a
"terminate" alternative or else a "free" decision of the task to exit, all
designs are equally bad.

> There is a lot of sense. In particular, in my version the task that
> invents jobs is never blocked on interactions with workers. This is a
> big advantage, because such a blocking would disturb its own
> interactions with the environment and reduce its responsiveness.

This is a design fault. Under certain conditions it must either block or
fail.

> In your version with rendezvous the task that invents jobs has to
> block and during that time it cannot react to the events that drive it
> (keyboard input, network transmission, etc.).

Wrong, see 9.7.1(16).

>> A better design would be:
>>
>> � �Server --> Scheduler <-- Worker
>>
>> The jobs are queued to the scheduler. Workers ask it for jobs to do.
>> Scheduler could be a protected object or a task.
> 
> Isn't it what I have proposed?

No. Decisive is who knows whom. Your design is when a multicasting
publisher "knows" its peers. This is a bad idea, obviously.

> Or the main task could promptly reject requests so that clients can
> back off or try to find another, less busy server.

>> Anyway it is no problem in my design. Use selective accept (RM 9.7.1):
>>
>> � �select
>> � � � when not Empty (Queue) �=> accept Get (Work : out Job) do
>> � � � � �... -- A worker is here to get a job from the FIFO
>> � � � end Get;
>> � �or when not Full (Queue) => accept Put (Work : out Job) do
>> � � � � �... -- A new job is to queue into the FIFO
>> � � � end Put;
>> � �or when Full (Queue) => delay Time_Out;
>> � � � ... -- Go to hell with your jobs!
>> � �end select;
> 
> But this looks like part of a separate task and the third branch still
> causes someone else to block.

No problem with that. There is "else part" of selective accept for this
9.7.1(19):
 
 � select
 �  � when not Empty (Queue) �=> accept Get ...
 � or when not Full (Queue) => accept Put ...
 � else
      ... -- Go to hell at once!
� �end select;

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

Re: Structure of the multitasking server

[Maciej Sobczak]

On 22 Wrz, 16:11, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
wrote:

> >> There also exists a third variant with an
> >> exception propagation.
>
> > This assumes rendezvous.
>
> Nope.

> Here is my example with exceptions (a complete program):
[...]

This example uses rendezvous.
I don't like it, because it misuses exceptions for something that is a
perfectly normal control flow.
Yes, this is very subjective - for the record, I also don't like the
End_Error exception.

BTW - the fact that you raise an exception only to shut it up in the
same scope indicates that this is a severe misuse of some language
feature.

> > In the version with protected objects the entity that triggers
> > termination might be different from the one that invents job.
> > In your version these different responsibilities are mixed.
>
> It does not work. You cannot selectively call to multiple entries of a
> protected object anyway.

I don't have to. What I said is that the entities that provide jobs
and that trigger termination can be different, not that the worker can
get them from separate channels.

> Then again, termination should be triggered by
> task finalization

Why? Which task?
The termination of workers can be triggered by the load that is below
some threshold. This is a valid strategy for dynamic task pool and is
not necessarily related to the finalization of the main task.

> > In particular, in my version the task that
> > invents jobs is never blocked on interactions with workers. This is a
> > big advantage, because such a blocking would disturb its own
> > interactions with the environment and reduce its responsiveness.
>
> This is a design fault. Under certain conditions it must either block or
> fail.

Where is the design fault? The immediate failure (as opposed to
blocking) can be a valid overload handling policy.
If I go to some office and cannot be handled because of the clerks
being too busy, I prefer to know it *immediately*, so that I can go to
the pub.

> > In your version with rendezvous the task that invents jobs has to
> > block and during that time it cannot react to the events that drive it
> > (keyboard input, network transmission, etc.).
>
> Wrong, see 9.7.1(16).

Again: keyboard input, network transmission, etc. Select statement is
not flexible enough.
In addition, there is no need to create even more tasks only to fit to
select's limitations.

> Your design is when a multicasting
> publisher "knows" its peers. This is a bad idea, obviously.

Why it is a bad idea? What is bad in the manager having knowledge
about workers in his team?
Is your boss aware of you or do you need to constantly ask him for new
tasks?

BTW - there is no multicasting in my design.

--
Maciej Sobczak * www.msobczak.com * www.inspirel.com

Database Access Library for Ada: www.inspirel.com/soci-ada

Re: Structure of the multitasking server

[Dmitry A. Kazakov]

On Tue, 23 Sep 2008 01:07:38 -0700 (PDT), Maciej Sobczak wrote:

> I don't like it, because it misuses exceptions for something that is a
> perfectly normal control flow.

I don't know how a control flow can be abnormal. If "normality" is
attributed to the meaning of program's artefacts, then that is at the
programmer's discretion. Is it normal not to have a job? For a worker that
might look abnormal, for a welfare receiver it maybe not...

> Yes, this is very subjective - for the record, I also don't like the
> End_Error exception.

But you certainly enjoy Constraint_Error... It is not subjective, it is
unrealistic.
 
> BTW - the fact that you raise an exception only to shut it up in the
> same scope indicates that this is a severe misuse of some language
> feature.

I use this language feature in order to express "not a value" in a
type-safe way. The same feature is used when an integer overflows.

You didn't want "no job" become a job, so I used exceptions instead. (A
return flag with a rubbish value is not an Ada way.)

>>> In the version with protected objects the entity that triggers
>>> termination might be different from the one that invents job.
>>> In your version these different responsibilities are mixed.
>>
>> It does not work. You cannot selectively call to multiple entries of a
>> protected object anyway.
> 
> I don't have to. What I said is that the entities that provide jobs
> and that trigger termination can be different, not that the worker can
> get them from separate channels.

If entries are different then the worker cannot selectively call to them.
If they are never called by it, then how is this related to the worker? In
your code there was only one entry called by the worker.

>> Then again, termination should be triggered by
>> task finalization
> 
> Why? Which task?

The worker task.

>>> In particular, in my version the task that
>>> invents jobs is never blocked on interactions with workers. This is a
>>> big advantage, because such a blocking would disturb its own
>>> interactions with the environment and reduce its responsiveness.
>>
>> This is a design fault. Under certain conditions it must either block or
>> fail.
> 
> Where is the design fault? The immediate failure (as opposed to
> blocking) can be a valid overload handling policy.

First you said that it neither blocks nor fail. Now you consider it to fail
immediately. Fine, let's take this. Why then to queue jobs, which are known
to fail later? (It is difficult to pursue a moving target...)

>>> In your version with rendezvous the task that invents jobs has to
>>> block and during that time it cannot react to the events that drive it
>>> (keyboard input, network transmission, etc.).
>>
>> Wrong, see 9.7.1(16).
> 
> Again: keyboard input, network transmission, etc. Select statement is
> not flexible enough.

1. The selective accept statement is flexible enough. And in any case it is
far more flexible than entry call statements. This is one of the reasons
why rendezvous might be better in one to many relationships.

The problem with the things you mentioned is that their interfaces are not
conform to Ada tasking. There are many reasons for this, unrelated to the
discussion.

2. Not all interfaces are like those.

3. In this particular case the server can block on job reception, because
this is the only event to react to.

>> Your design is when a multicasting
>> publisher "knows" its peers. This is a bad idea, obviously.
> 
> Why it is a bad idea? What is bad in the manager having knowledge
> about workers in his team?

Yes, obviously. This requires a team and maintenance of. Such managers are
expensive and exposed to various risks. It might appear the only way of
design when you deal with humans, but fortunately, with bits and bytes
there are much better options.

> Is your boss aware of you or do you need to constantly ask him for new
> tasks?

This is a model widely used when you don't want to employ staff
permanently. If you have plenty of free workers, you just sit and wait them
to come. Fee is paid per work made. See freelances, etc.

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

Re: Structure of the multitasking server

[Jean-Pierre Rosen]

Maciej Sobczak a �crit :
> This example uses rendezvous.
> I don't like it, because it misuses exceptions for something that is a
> perfectly normal control flow.
> Yes, this is very subjective - for the record, I also don't like the
> End_Error exception.
> 
> BTW - the fact that you raise an exception only to shut it up in the
> same scope indicates that this is a severe misuse of some language
> feature.
> 
This is a very restrictive (although widely shared) view of exceptions, 
where you consider that they are only for signaling failures.

Exceptions are a programming tool for handling situations that are 
"exceptions" to the regular processing. This is the case for errors of 
course, but end of processing is perfectly appropriate.

Moreover, using exceptions in this case has the benefit that the worker 
cannot ignore the signal (as would be the case with an out parameter). 
If the exception is not handled, the worker will crash, but not block 
the system.

-- 
---------------------------------------------------------
            J-P. Rosen (rosen@adalog.fr)
Visit Adalog's web site at http://www.adalog.fr

Re: Structure of the multitasking server

[Maciej Sobczak]

On 19 Wrz, 15:34, Jean-Pierre Rosen <ro...@adalog.fr> wrote:

> Why not simply use a rendezvous?

This is something that I deliberately wanted to avoid.
I don't like the idea of tasks interacting with each other directly
and I prefer to have the communication part extracted away (Ravenscar
got that right for a reason, I think?).

In theory, I could also change the queuing strategy without modifying
the worker task.

--
Maciej Sobczak * www.msobczak.com * www.inspirel.com

Database Access Library for Ada: www.inspirel.com/soci-ada

Re: Structure of the multitasking server

[Jean-Pierre Rosen]

Maciej Sobczak a �crit :
> On 19 Wrz, 15:34, Jean-Pierre Rosen <ro...@adalog.fr> wrote:
> 
>> Why not simply use a rendezvous?
> 
> This is something that I deliberately wanted to avoid.
> I don't like the idea of tasks interacting with each other directly
> and I prefer to have the communication part extracted away (Ravenscar
> got that right for a reason, I think?).
You said "I prefer", so this can be a matter of taste ;-)

Personnally, I view protected types as a great tool for simple, 
low-level communications, and rendezvous for higher level 
communications. I think rendezvous are closer to real-life, and thus 
easier to manage. YMMV of course.

The issue for Ravenscar is different: it is a matter of provability.
There are many examples of things that are simpler for the human being, 
but less easy for proofs systems...

-- 
---------------------------------------------------------
            J-P. Rosen (rosen@adalog.fr)
Visit Adalog's web site at http://www.adalog.fr

Re: Structure of the multitasking server

[gautier_niouzes]

Thanks Jean-Pierre Rosen for this elegant solution!
For a very simple simulation framework I need, here is a even simplified variant that is working perfectly. In this case the parameters passed to the task entries are just a job number and the worker's number, for information.

  procedure Process_parallel is
    workers: array(1..8) of Worker_type;
  begin
    for d in is_driver'Range loop  
      Looking_for_idle:
      loop
        for w in workers'range loop
          select
            workers(w).Run(d, w);
            exit Looking_for_idle;
          else
            null; -- Worker is busy
          end select;
        end loop;
      end loop Looking_for_idle;
    end loop;
  end Process_parallel;
_________________________ 
Gautier's Ada programming 
http://gautiersblog.blogspot.com/search/label/Ada 
NB: follow the above link for a valid e-mail address 

Re: Structure of the multitasking server

[Jacob Sparre Andersen]

gautier_niouzes@hotmail.com writes:

>       Looking_for_idle:
>       loop
>         for w in workers'range loop
>           select
>             workers(w).Run(d, w);
>             exit Looking_for_idle;
>           else
>             null; -- Worker is busy
>           end select;
>         end loop;
>       end loop Looking_for_idle;

This looks like a busy-wait to me.  Is it?  If not, why not?

Greetings,

Jacob
-- 
"Nobody writes jokes in base 13."
 Douglas Adams

Re: Structure of the multitasking server

[gautier_niouzes]

Le jeudi 12 mars 2015 22:38:50 UTC+1, Jacob Sparre Andersen a écrit :

> This looks like a busy-wait to me.  Is it?  If not, why not?

Seems so. Is it bad? Well it may eat one core or CPU's performance.
Is it better with a small delay (see below) to cool down the boss ?
Anyway the system is working fine.
BTW, I had forgotten a Stop entry: when all the work was done, the workers were still waiting for more :-).

  procedure Process_parallel is
    workers: array(1..8) of Worker_type;
  begin
    All_drivers_numbers:
    for d in is_driver'Range loop  
      Looking_for_idle:
      loop
        for w in workers'range loop
          select
            workers(w).Run(d, w);
            exit Looking_for_idle;
          else
            null; -- workers(w) is busy
          end select;
        end loop;
        delay 0.01;
      end loop Looking_for_idle;
    end loop All_drivers_numbers;
    for w in workers'range loop
      workers(w).Stop(w);
    end loop;    
  end Process_parallel;
_________________________ 
Gautier's Ada programming 
http://www.openhub.net/accounts/gautier_bd

Re: Structure of the multitasking server

[Dmitry A. Kazakov]

On Thu, 12 Mar 2015 15:39:02 -0700 (PDT), gautier_niouzes@hotmail.com
wrote:

> Le jeudi 12 mars 2015 22:38:50 UTC+1, Jacob Sparre Andersen a écrit :
> 
>> This looks like a busy-wait to me.  Is it?  If not, why not?
> 
> Seems so. Is it bad?

Yes.

> Well it may eat one core or CPU's performance.
> Is it better with a small delay (see below) to cool down the boss ?

You could add a wakeup event to prevent busy waiting. An alternative would
be a waitable jobs queue.

BTW, you seem have another problem. The drivers/workers are serviced always
in the same order which would systematically choke ones near to the list
end. A usual solution of this problem is list walking entered at the point
where it was left.

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

Re: Structure of the multitasking server

[gautier_niouzes]

Le vendredi 13 mars 2015 09:14:52 UTC+1, Dmitry A. Kazakov a écrit :

> You could add a wakeup event to prevent busy waiting. An alternative would
> be a waitable jobs queue.

Wouldn't a delay instruction help ?

> BTW, you seem have another problem. The drivers/workers are serviced always
> in the same order which would systematically choke ones near to the list
> end. A usual solution of this problem is list walking entered at the point
> where it was left.

Do you mean worker #1 would tend to be overworked compared to the others ?
In the program I run - perhaps because the jobs are long: a few seconds number crunching - it doesn't seem to be the case:

Worker 1	362	jobs
Worker 2	540	jobs
Worker 3	652	jobs
Worker 4	359	jobs
Worker 5	366	jobs
Worker 6	592	jobs
Worker 7	371	jobs
Worker 8	370	jobs

G.

Re: Structure of the multitasking server

[Dmitry A. Kazakov]

On Fri, 13 Mar 2015 13:16:29 -0700 (PDT), gautier_niouzes@hotmail.com
wrote:

> Le vendredi 13 mars 2015 09:14:52 UTC+1, Dmitry A. Kazakov a écrit :
> 
>> You could add a wakeup event to prevent busy waiting. An alternative would
>> be a waitable jobs queue.
> 
> Wouldn't a delay instruction help ?

It helps switching to another task before the scheduler preemts the task
Process, which would normally happen after a timer interrupt. If Process is
through *before* the time quant is expired, delay 0.0 cause Process giving
up the core.

[I don't understand what are you going to do]

>> BTW, you seem have another problem. The drivers/workers are serviced always
>> in the same order which would systematically choke ones near to the list
>> end. A usual solution of this problem is list walking entered at the point
>> where it was left.
> 
> Do you mean worker #1 would tend to be overworked compared to the others ?
> In the program I run - perhaps because the jobs are long: a few seconds
> number crunching - it doesn't seem to be the case:
> 
> Worker 1	362	jobs
> Worker 2	540	jobs
> Worker 3	652	jobs
> Worker 4	359	jobs
> Worker 5	366	jobs
> Worker 6	592	jobs
> Worker 7	371	jobs
> Worker 8	370	jobs

The problem should first appear under 100% load. It would not appear if you
never exit the loop. But it seems that you do. (Not that I really
understand what are you going to achieve.)

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

Re: Structure of the multitasking server

[gautier_niouzes]

There is 100% load in my case. 8 worker tasks, 8 CPUs, all busy with the number crunching. What I'm doing is running computation jobs in parallel on different tasks and ensuring all tasks are busy. Each time a worker is done, it gets quickly a new job and I'm happy.

...
    << Worker 7       done with driver 3369
>>     Worker 7   starting with driver 3380
    << Worker 8       done with driver 3372
>>     Worker 8   starting with driver 3381
    << Worker 6       done with driver 3374
>>     Worker 6   starting with driver 3382
    << Worker 4       done with driver 3378
>>     Worker 4   starting with driver 3383
    << Worker 3       done with driver 3377
>>     Worker 3   starting with driver 3384
    << Worker 5       done with driver 3375
>>     Worker 5   starting with driver 3385
    << Worker 7       done with driver 3380
>>     Worker 7   starting with driver 3386
...
_________________________ 
Gautier's Ada programming 
http://sf.net/users/gdemont/

Re: Structure of the multitasking server

[Simon Wright]

gautier_niouzes@hotmail.com writes:

> There is 100% load in my case. 8 worker tasks, 8 CPUs, all busy with
> the number crunching. What I'm doing is running computation jobs in
> parallel on different tasks and ensuring all tasks are busy. Each time
> a worker is done, it gets quickly a new job and I'm happy.

I know this isn't closely related, but make has the flag -j (--jobs), which
specifies the number of jobs to run simultaneously. --jobs=4 was OK
(this is a Macbook Pro with an Intel Core i5), but building GCC with
just --jobs (run as many jobs simultaneously as possible) froze the
machine to the point where a forced power cycle was the only option. I
wasn't happy.

Re: Structure of the multitasking server

[J-P. Rosen]

Le 15/03/2015 08:43, gautier_niouzes@hotmail.com a écrit :
> There is 100% load in my case. 8 worker tasks, 8 CPUs, all busy with
> the number crunching. What I'm doing is running computation jobs in
> parallel on different tasks and ensuring all tasks are busy. Each
> time a worker is done, it gets quickly a new job and I'm happy.
> 
> ...

If you give the producer a lower priority than the workers, it will be
activated only when workers are done, and busy waiting is no more a problem.

-- 
J-P. Rosen
Adalog
2 rue du Docteur Lombard, 92441 Issy-les-Moulineaux CEDEX
Tel: +33 1 45 29 21 52, Fax: +33 1 45 29 25 00
http://www.adalog.fr

Re: Structure of the multitasking server

[Jacob Sparre Andersen]

J-P. Rosen wrote:

> If you give the producer a lower priority than the workers, it will be
> activated only when workers are done, and busy waiting is no more a
> problem.

Nice solution. :-)

Greetings,

Jacob
-- 
"Any, sufficiently complicated, experiment is indistinguishable from magic."

Re: Structure of the multitasking server

[Brad Moore]

On 15-03-15 03:21 AM, Jacob Sparre Andersen wrote:
> J-P. Rosen wrote:
>
>> If you give the producer a lower priority than the workers, it will be
>> activated only when workers are done, and busy waiting is no more a
>> problem.

I use this approach in the Ravenscar Paraffin libraries.

Note though, that this approach only works on real-time systems, which implement the priority model.

Linux (and Windows) for example by default doesn't do this, so the spinning of the lower priority task can interfere
with the higher priority tasks running on the same core. If you are using a flavor of Linux that has been configured for
real-time then you should be able to rely on this behaviour.

   See
     https://rt.wiki.kernel.org/index.php/RT_PREEMPT_HOWTO#About_the_RT-Preempt_Patch

Otherwise, this approach doesn't really work (it works but inefficient because CPU is wasted on spinning),
so you should use blocking instead of spin waiting.
In Paraffin, I provide two versions of Ravenscar libraries (one blocking, and one spinning), so that you can use
whichever version best suits your OS.

Brad

>
> Nice solution. :-)
>
> Greetings,
>
> Jacob
>

Re: Structure of the multitasking server

[Randy Brukardt]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 828 bytes --]

<gautier_niouzes@hotmail.com> wrote in message 
news:c943b1fd-8c0c-4c22-ba8c-fb72fbd52805@googlegroups.com...
Le vendredi 13 mars 2015 09:14:52 UTC+1, Dmitry A. Kazakov a écrit :

>> You could add a wakeup event to prevent busy waiting. An alternative 
>> would
>> be a waitable jobs queue.

>Wouldn't a delay instruction help ?

Of course. A "slow busy wait" is good enough in almost all circumstances 
(typically, the machine isn't doing anything important anyway during that 
the minimal time used). It certainly beats distorting one's design.

Of course, if there is a queue of jobs anyway, it makes sense to arrange 
that to be blocking so you end up waiting on that. But then of course you 
need a "stop" job else the supervisor ends up waiting forever.

                                                         Randy.

Re: Structure of the multitasking server

[Simon Wright]

"Randy Brukardt" <randy@rrsoftware.com> writes:

> Of course, if there is a queue of jobs anyway, it makes sense to
> arrange that to be blocking so you end up waiting on that. But then of
> course you need a "stop" job else the supervisor ends up waiting
> forever.

Having the supervisor wait forever is OK in some circumstances
(particularly in embedded systems). Though I had to introduce one to
support offline tests (you need to be able to go on to the next test!)

Re: Structure of the multitasking server

[anon]

Since you are using Channels, I am assuming that your talking about TCP/IP 
servers. In this case you should look into using the Check_Selector with 
the use of Signalling_Fds and Socket_Sets instead of using arrays.

Now the way GNAT has written the Selector function and the way the C_Select
is written the maximum number of server per Check_Selector is 27.  That is, 
each C_Select function can only monitor 32 sockets, but 
GNAT.Sockets.Create_Selector uses two socket and the TCP/IP sub-system 
uses or predefines 3, so you are left with 27 user define servers.

Found this clent/server on the net.  The following client/server shows how to 
use the Check_Selector routine. They were both were written in all caps and 
use Ada-95 spec so,  you may need to adjust the Signalling_Fds routine 
calls for Ada-2005 (GNAT-2008), but they do compile and excute under 
GNAT GPL 2007 using Linux. 

Note: 1) I alter for spacing and cap format. To make them more readable.
      2) The procedure "Set_Socket_Option" may need to be commented 
          out.  Some TCP/IP system do not like GNAT version of that 
          routine.
      3) As for Windows, I did not test!


--------------------------------------------------------------
--
--  Pool_Server
--
with GNAT.Sockets ; 
use GNAT.Sockets ;
with Ada.Text_IO ;

procedure Pool_Server is

    MaxTasks : constant Positive := 5 ;  -- buffer size
    type Index is mod MaxTasks ;

    function Rev ( S : String ) return String is
        Res : String ( S'Range ) ;
        J : Integer := S'First ;
      begin
        for I in reverse S'Range loop
         Res ( J ) := S ( I ) ;
         J := J + 1 ;
        end loop ;
        return Res ;
      end Rev ;

    protected Aborted is
      procedure Set ;
      function Check return Boolean ;
    private
      Done : Boolean := False ;
    end Aborted ;

    protected body Aborted is
      procedure Set is
        begin
          Done := True ;
        end Set ;

      function Check return Boolean is
        begin
          return Done ;
        end Check ;
    end Aborted ;


   type Echo ;
   type Echo_Access is access Echo ;

    task type Echo is
      entry Start ( N_Sock : IN Socket_Type ;
                    Self : IN Echo_Access   ) ;
      entry ReStart ( N_Sock : IN Socket_Type ) ;
    end Echo ;

    type Task_Array is array ( Index ) of Echo_Access ;

    protected Buffer is
      entry Deposit ( X : in Echo_Access ) ;
      entry Extract ( X : out Echo_Access ) ;
      function NumWaiting return Natural ;
    private
      Buf : Task_Array ;
      I, J : Index := 0 ;
      Count : Natural range 0 .. MaxTasks := 0 ;
    end Buffer ;


    task body Echo is
        Sock : Socket_Type ;
        S : Stream_Access ;
        Me : Echo_Access ;
        Input_Selector : Selector_Type ;
        Input_Set : Socket_Set_Type ;
        WSet : Socket_Set_Type ;
        Input_Status : Selector_Status ;
      begin
      --set up selector
      Create_Selector ( Input_Selector ) ;

      --Initialise socket sets
      --WSet is always empty as we are not interested in output events
      -- RSet only ever contains one socket namely Sock
      Empty ( Input_Set ) ;
      Empty ( WSet ) ;

      ACCEPT Start ( N_Sock : IN Socket_Type ;
                     Self : IN Echo_Access   ) DO
        Sock := N_Sock ;
        Me := Self ;
      end Start ;

      loop
        begin   -- block for exception handling
          S := Stream ( Sock ) ;    -- set up stream on socket
          Boolean'Write ( S, True ) ;  -- acknowledge connection

          loop
            -- check for input on Sock socket
            Set ( Input_Set, Sock ) ;

            -- time-out on check if no input within 0.5 second
            Check_Selector ( Input_Selector,
                             Input_Set,
                             WSet,
                             Input_Status,
                             0.5 ) ;
            if Input_Status = Completed then
              -- we have input, so process it
              declare
                  Str : String := String'Input ( S ) ;
              begin
                exit when Str = "quit" ;
                String'Output ( S, Rev ( Str ) ) ;
              end ;
            end if ;
            if Aborted.Check then
              String'Output ( S, "Server aborted" ) ;
              exit ;
            end if ;
          end loop ;

          Ada.Text_IO.New_Line ;
          Ada.Text_IO.Put_Line ( "Slave Closing Connection" ) ;
          ShutDown_Socket ( Sock, Shut_Read_Write ) ;
          Buffer.Deposit ( Me ) ;

          exception
            -- The mostly likely exception is if client quits unexpectedly
            -- close the socket and deposit ourselves in the buffer
          when others =>
               Ada.Text_IO.New_Line ;
               Ada.Text_IO.Put_Line ( "Connection closed unexpectedly" ) ;
               Close_Socket ( Sock ) ;
               Buffer.Deposit ( Me ) ;
        end ;

        select
          ACCEPT ReStart ( N_Sock : IN Socket_Type ) DO
            Sock := N_Sock ;
          end ReStart ;
        or
          -- terminate if all slaves are queued here and
          -- if the main server task has finished
          terminate ;
        end select ;

      end loop ;
    end Echo ;

    protected body Buffer is
      entry Deposit ( X : IN Echo_Access ) when Count < MaxTasks is
        begin
          Buf ( I ) := X ;
          I := I + 1 ;
          Count := Count + 1 ;
        end Deposit ;

      entry Extract ( X : OUT Echo_Access ) when Count > 0 is
        begin
          X := Buf ( J ) ;
          J := J + 1 ;
          Count := Count - 1 ;
        end Extract ;

      function NumWaiting return Natural is
      begin
         return Count ;
      end NumWaiting ;
   end Buffer ;

    Server          : Socket_Type ;
    New_Sock        : Socket_Type ;
    Slave           : Echo_Access ;
    Addr            : Sock_Addr_Type ( Family_Inet ) ;
    Peer_Addr       : Sock_Addr_Type ( Family_Inet ) ;
    Avail           : Boolean := False ;
    Ch              : Character ;
    TotalTasks      : Natural := 0 ;
    Accept_Selector : Selector_Type ;
    Accept_Set      : Socket_Set_Type ;
    WSet            : Socket_Set_Type ;
    Accept_Status   : Selector_Status ;

  begin  --  main server task
    Ada.Text_IO.Put_Line ( "WARNING server loops for ever." ) ;
    Ada.Text_IO.Put ( "Press A to terminate server and all " ) ;
    Ada.Text_IO.Put_Line ( "tasks immediately or press Q to ") ;
    Ada.Text_IO.Put ( "accept no further connections and " ) ;
    Ada.Text_IO.Put ( "terminate gracefully when all clients " ) ;
    Ada.Text_IO.Put ( "are fully when all clients are through." ) ;
    Ada.Text_IO.New_Line ;
    Initialize ;
    Create_Socket ( Server) ;
    Addr := ( Family_Inet,
              Addresses ( Get_Host_By_Name ( Host_Name ), 1 ),
              50000 ) ;
    --  allow server address to be reused for multiple connections
    Set_Socket_Option ( Server, 
                        Socket_Level,
                        ( Reuse_Address, True ) ) ;

    Bind_Socket ( Server, Addr ) ;
    Listen_Socket ( Server, 4 ) ;

    --  set up selector
    Create_Selector ( Accept_Selector ) ;

    --  Initialise socket sets
    --  WSet is always empty as we are not interested in output 
    --  events Accept_Set only ever contains one socket namely 
    --  Server
    Empty ( Accept_Set ) ;
    Empty ( WSet ) ;
    loop
      Ada.Text_IO.Get_Immediate ( Ch, Avail ) ;
      if Avail and then
         ( Ch = 'q' or Ch = 'Q' or Ch = 'a' or Ch = 'A' ) then
        exit ;
      end if ;

      --  check for input (connection requests) on Server socket
      Set ( Accept_Set, Server ) ;
      --  time-out on check if no request within 1 second
      Check_Selector ( Accept_Selector, 
                       Accept_Set,
                       WSet, 
                       Accept_Status, 
                       1.0 ) ;

      if Accept_Status = Completed then
        --  must be an event on Server socket as it is the only 
        --  one that we are checking.
        --  Hence the Accept_Socket call should not block.

        Accept_Socket ( Server, New_Sock, Peer_Addr ) ;
        Ada.Text_IO.New_Line ;
        Ada.Text_IO.Put_Line 
                        ( "Connection accepted -- allocating slave" ) ;


      if Buffer.NumWaiting = 0  and TotalTasks < MaxTasks then
          Slave := NEW Echo ;              -- start new task
          TotalTasks := TotalTasks + 1 ;
          Ada.Text_IO.Put_Line ( "New slave task started" ) ;
          --  call entry Start to activate task
          Slave.Start ( New_Sock, Slave ) ;
        else
          Ada.Text_IO.Put_Line ( "Waiting for an idle slave task" ) ;
          Buffer.Extract ( Slave ) ;
          --  call entry Start to re-activate task
          Slave.ReStart ( New_Sock ) ;
          Ada.Text_IO.Put_Line ( " Idle slave task reactivated" ) ;
        end if ;
      end if ;
    end loop ;

    if Ch = 'a' or Ch = 'A' then
      --  signal slave tasks to terminate
      Aborted.Set ;
    end if ;

   --  tidy up
    Close_Selector ( Accept_Selector ) ;
    Empty ( Accept_Set ) ;

    Close_Socket ( Server ) ;
    Ada.Text_IO.New_Line ;
    Ada.Text_IO.Put_Line ( "Main server task exiting ..." ) ;
    Finalize ;
end Pool_Server ;


--------------------------------------------------------------
--
--  Pool_Client
--
with Gnat.Sockets ;
use  Gnat.Sockets ;
with Ada.Command_Line ; 
use  Ada.Command_Line ;
with Ada.Text_IO ;
use  Ada.Text_IO ;

procedure Pool_Client is
    Sock : Socket_Type ;
    S : Stream_Access ;
    Addr : Sock_Addr_Type ( Family_Inet ) ;
    Msg : String ( 1 .. 80 ) ;
    Last : Natural ;
    B : Boolean ;
    Read_Selector : Selector_Type ;
    Read_Set, WSet : Socket_Set_Type ;
    Read_Status : Selector_Status ;
  begin
    Initialize ;
    Create_Socket ( Sock ) ;
    Addr := ( Family_Inet,
              Addresses ( Get_Host_By_Name ( Argument ( 1 ) ), 1 ),
              50000 ) ;
    Create_Selector ( Read_Selector ) ;
    Empty ( Read_Set ) ;
    Empty ( WSet ) ;


    Connect_Socket ( Sock, Addr ) ;
    S := Stream ( Sock ) ;
    Boolean'Read ( S, B ) ;
    -- wait for connection to be accepted

    loop
      Set ( Read_Set, Sock ) ;

      -- check for input on socket  (server may be aborting)
      -- time-out immediately if no input pending
      -- We seem to need a small delay here (using zero seems to block
      -- forever)
      -- Is this a GNAT bug or AB misreading Check_Selector docs?

      Check_Selector ( Read_Selector, 
                       Read_Set,
                       WSet, 
                       Read_Status,
                       0.005 ) ;
      if Read_Status = Expired then
        Ada.Text_IO.Put ( "Message> " ) ;  -- prompt user for message
        Ada.Text_IO.Get_Line ( Msg, Last ) ;

        -- send message to socket unless server is aborting
        String'Output ( S, Msg ( 1 .. Last ) ) ;
        exit when Msg ( 1 .. Last ) = "quit" ;
      end if ;

      declare 
          -- receive message
          Str : String := String'Input ( S ) ;
      begin      Ada.Text_IO.Put_Line ( Str ) ;
        exit when Str = "Server aborted" ;
      end ;
    end loop ;

    Ada.Text_IO.Put_Line ( "Client quitting ..." ) ;
    ShutDown_Socket ( Sock ) ;
    Close_Selector ( Read_Selector ) ;
    Finalize ;
  exception 
    when others =>
        Ada.Text_IO.Put_Line ("Exception: Client quitting ..." ) ;
        Close_Socket ( Sock ) ;
        Close_Selector( Read_Selector ) ;
        Finalize ;
  end Pool_Client ;


In <8b4d1170-22e6-40d3-8ed1-096dc0163491@m36g2000hse.googlegroups.com>, Maciej Sobczak <see.my.homepage@gmail.com> writes:
>Hi all,
>
>Imagine a server with fixed number of worker tasks. There is no queue
>of jobs and jobs are immediately passed to one of the tasks that is
>currently idle. There is a separate task (or just the main one) that
>provides jobs for worker tasks.
>
>I am concerned with the proper structure of objects - I mean in the
>sense of recommended Ada practice.
>Obviously there is a need for some shared resource where the
>requesting task will put the job and from where the worker task will
>pick it up.
>
>This is more or less what I came up with, where the "channel" is a
>single processing pipeline:
>
>   type Worker_State is (Idle, Ready, Working);
>
>   protected type Channel_State is
>      procedure Post (J : in Job_Type);
>      entry Get_Job (J : out Job_Type);
>      function Busy return Boolean;
>   private
>      State : Worker_State := Idle;
>      Job_To_Do : Job_Type;
>   end Channel_State;
>
>   protected body Channel_State is
>
>      procedure Post (J : in Job_Type) is
>      begin
>         if State /= Idle then
>            raise Program_Error;
>         end if;
>
>         Job_To_Do := J;
>         State := Ready;
>      end Post;
>
>      entry Get_Job (J : out Job_Type) when State = Ready is
>      begin
>         J := Job_To_Do;
>         State := Working;
>      end Get_Job;
>
>      function Busy return Boolean is
>      begin
>         return State /= Idle;
>      end Busy;
>
>   end Channel_State;
>
>   type Channel;
>   task type Worker_Task (Ch : access Channel);
>
>   type Channel is record
>      State : Channel_State;
>      Worker : Worker_Task (Channel'Access);
>   end record;
>
>   task body Worker_Task is
>      Job : Job_Type;
>   begin
>      loop
>         Ch.all.Get_Job (Job);
>
>         --  do the job ...
>
>      end loop;
>   end Worker_Task;
>
>   Max_Channels : constant := 5;
>
>   Channels : array (1 .. Max_Channels) of Channel;
>
>My question is whether this is what a seasoned Ada programmer would
>do.
>Initially I tried to have two separate arrays, one for jobs and one
>for worker tasks, but I found it difficult to link workers with their
>respective jobs. After bundling them together in a single record that
>is referenced from the task it worked and I actually find it
>structured better.
>
>The main task after constructing a job object finds some channel where
>the worker task is not busy and posts the job to its shared state
>component:
>
>   loop
>      Job := ...
>
>      Found_Worker := False;
>      for I in Channels'Range loop
>         if not Channels (I).State.Busy then
>            Channels (I).State.Post (Job);
>            Found_Worker := True;
>            exit;
>         end if;
>      end loop;
>
>      if not Found_Worker then
>         --  all pipelines are busy,
>         --  but the overflow handling is not shown...
>      end if;
>   end loop;
>
>All this works fine, but my question considers the choice of language
>constructs and idioms.
>
>--
>Maciej Sobczak * www.msobczak.com * www.inspirel.com
>
>Database Access Library for Ada: www.inspirel.com/soci-ada

Re: Structure of the multitasking server

[Maciej Sobczak]

On 20 Wrz, 01:01, a...@anon.org (anon) wrote:

> Since you are using Channels, I am assuming that your talking about TCP/IP
> servers.

Not necessarily, although in this case it is indeed true.

> In this case you should look into using the Check_Selector

Why? If I want to keep the number of pipelines relatively small, then
fixed pool of tasks seems to be quite clean.

> Now the way GNAT has written the Selector function and the way the C_Select
> is written the maximum number of server per Check_Selector is 27.

Is it documented somewhere?
The only "documentation" I have found is the .ads file for
GNAT.Sockets, and this detail is not mentioned there.

Also, on my system the default limit on the number of file descriptors
used with select(2) is 1024.

> That is,
> each C_Select function can only monitor 32 sockets

What is C_Select? Why would it be more limited than select(2) (the
system-level one)?

--
Maciej Sobczak * www.msobczak.com * www.inspirel.com

Database Access Library for Ada: www.inspirel.com/soci-ada

Re: Structure of the multitasking server

[anon]

  Why use "GNAT.Sockets.Check_Selection"?

Well, in TCP/IP system the designers of TCP/IP created a routine called
TCP/IP "Select", that is designed to allow the use of multi-servers or 
multitasking type of servers within one environment. There are reasons 
that goes beyond Ada and other languages that states why a multi server 
design should use the TCP/IP "Select" routine instead of multi tasks where 
each task uses a TCP/IP "Accept" statements to block the server routine 
until a call or a connection is made, basically it has to do with limited 
system resources.  

Note: TCP/IP "Accept" can only monitor one connection port while the 
TCP/IP "Select" allows monitoring up to 32 at one time in one routine.
which makes the TCP/IP "Select" a better utilization of system resources.

Now, in GNAT the TCP/IP "Select" routine is ported to Ada by the function 
"GNAT.Sockets.Thin.C_Select" which is the low-level C and non-portable 
version of the routine. The non-portable TCP/IP "Select" is wrapped into 
a procedure called "GNAT.Sockets.Check_Selection" that is more portable.

Why only 27 servers per TCP/IP "Select" routine  Well, the designers created 
the TCP/IP "Select" to use 3 32-bit word to detect or flag, up to 32 servers 
(bitmapped). Now, the TCP/IP system uses the first 3 file descriptors mapped 
onto the first 3 sockets positions and are defined as the standard system I/O 
(Stdin (0), Stdout (1), Stderr (2)) which is hard coded in the TCP/IP "Select" 
routine.  And the designer of the "GNAT.Sockets" uses two additional random 
assigned sockets or file descriptors (depends on port/version of GNAT) to build 
the Selector type for interfacing with the TCP/IP "Select" routine.  So, 

  27 (User Allowed sockets) :=
           32 (total sockets) - 3 (System defined) - 2 (GNAT RTL used) 


Note: For Full documentation on why 32 sockets you will need to check 
with the history of TCP/IP for the full story, but I would guess it 
was because of limited resources back then. Most servers back then only 
handle a few services, and that has not changed too much in todays world. 
Today, only, the volume of clients has increased.

Plus, some system may have 1024 file descriptors, but the OS normally 
limit the number of assigned/open file descriptors to 32 or less. And 
that includes the 3 Standard I/O files.

--  TCP/IP Server Designed (GNAT)

Now, the best and "Tried and True" design for a multiple service server 
is for a single batch designed monitor task with multi-service server task.  
The monitor task setup and monitor 2 to 27 sockets.  Then activate the 
service server task, afterwards quickly reset and monitors/idles until 
the next request is made. Simple and straight foreword design.

Why Best design: Uses less resources including CPU cycles.  Which allow 
the server tasks and other programs a timely access to their resource needs.

--
-- A simple outline for a multiple services type of TCP/IP server task
--
Server_Controller_Task: 

    Server_Number : Natural ; -- Set to maximum number of server task
                              -- value ranges 5..32 (27) ;

     -- Initialize Controller variables 

    for Server_task_count in 5..Server_Number loop
       idle until called ( Ada "Accept" statement ) ( socket )
       map socket to the Signalling_Fds (read/write/exception)
    end loop


    -- Monitoring Routine: idle until a server is needed.

    loop
      setup or reset Selector variables  -- required for every call
      call Check_Selector function       --  Idle until connected
      Using returned Signalling_Fds, find and call the server task to handle job
    end loop

    exception
        shutdown server in case of TCP/IP system exception. Or
        Storage_Error, Program_Error, etc.

--
-- Each "Server_Service_Task" handles one type of service.
--
Server_Service_Task: 5..MAX(32):

    -- Initialize: Inform controller task that server exist
    --             and is ready to handle request.

    Create Socket 
    Bind Socket to port and address

           --  This call assign and map Socket to Signalling_Fds value
           --  which allows the controller server to monitor the 
           --  connection request and active this server when needed.
    Call controller_task  ( Socket )


    -- idle task until called. Then handle request. 

    loop 
        Set server resources to idle
        idle until called to handle server job. ( Ada "Accept" statement )
        Open Channel
        Handle server service job 
        Close Channel
        exception
          handle lost of connection.  Reset for next call
    end loop
    exception
        handle Socket_Error in case of TCP/IP Socket exception. 

        shutdown server in case of TCP/IP system exception. Or
        Storage_Error, Program_Error, etc.




In <2cfc647a-c9cb-4e0c-9909-7923575fd1ec@d1g2000hsg.googlegroups.com>, Maciej Sobczak <see.my.homepage@gmail.com> writes:
>On 20 Wrz, 01:01, a...@anon.org (anon) wrote:
>
>> Since you are using Channels, I am assuming that your talking about TCP/I=
>P
>> servers.
>
>Not necessarily, although in this case it is indeed true.
>
>> In this case you should look into using the Check_Selector
>
>Why? If I want to keep the number of pipelines relatively small, then
>fixed pool of tasks seems to be quite clean.
>
>> Now the way GNAT has written the Selector function and the way the C_Sele=
>ct
>> is written the maximum number of server per Check_Selector is 27.
>
>Is it documented somewhere?
>The only "documentation" I have found is the .ads file for
>GNAT.Sockets, and this detail is not mentioned there.
>
>Also, on my system the default limit on the number of file descriptors
>used with select(2) is 1024.
>
>>=A0That is,
>> each C_Select function can only monitor 32 sockets
>
>What is C_Select? Why would it be more limited than select(2) (the
>system-level one)?
>
>--
>Maciej Sobczak * www.msobczak.com * www.inspirel.com
>
>Database Access Library for Ada: www.inspirel.com/soci-ada

Re: Structure of the multitasking server

[Maciej Sobczak]

On 22 Wrz, 04:32, a...@anon.org (anon) wrote:

>   Why use "GNAT.Sockets.Check_Selection"?

> [...] basically it has to do with limited
> system resources.

Of course, but as I've said, the intended (fixed) number of pipelines
is relatively small and the system resources do not seem to be any
limitation.

> Note: TCP/IP "Accept" can only monitor one connection port while the
> TCP/IP "Select" allows monitoring up to 32 at one time in one routine.
> which makes the TCP/IP "Select" a better utilization of system resources.

I don't understand this assertion. You cannot *replace* accept with
select, they serve completely different purposes, so you cannot state
that one is better than another.

> Why only 27 servers per TCP/IP "Select" routine  Well, the designers created
> the TCP/IP "Select" to use 3 32-bit word to detect or flag

This is an implementation detail that does not seem to be true any
longer. As I've already explained, on my system the default limit for
select(2) is 1024 descriptors and with a simple compiler option can be
actually unlimited.

The limit of 32 seems to be very impractical today. It is not uncommon
to have hundreds of clients connected at the same time to a single
server. They can be all handled without any partitioning.

> Plus, some system may have 1024 file descriptors, but the OS normally
> limit the number of assigned/open file descriptors to 32 or less.

Again, this is not true on any of the systems that I have access to.

--
Maciej Sobczak * www.msobczak.com * www.inspirel.com

Database Access Library for Ada: www.inspirel.com/soci-ada

Re: Structure of the multitasking server

[anon]

--
--  A Server and a Client that shows how to use 
--  GNAT.Sockets.Check_Selection as a controller for
--  multiple port server. And can be alter to allow multiple 
--  services type of server.
--
--  In C,  they call this type of server a Super-Server Class 
--  of servers.
--

-- ------------------------------------------------------------ --
-- Multi-Tasking Server that allows Multi-Service to be handled --
-- ------------------------------------------------------------ --

with Ada.Text_IO ;
with GNAT.Sockets ;
with System ;

use  Ada.Text_IO ;
use  GNAT.Sockets ;

procedure testserver is 


  -- ------------------- --
  --  Server Task Types  --
  -- ------------------- --

    -- 
    --  TCP Task
    -- 

    task tcp_hello is
        entry Initialize ;
        entry Acknowledge ;
      end tcp_hello ;


    -- 
    --  UDP Task
    -- 

    task udp_hello is
        entry Initialize ;
        entry Acknowledge ;
      end udp_hello ;


    Server_Error  : exception ;

    tcp_Socket    : Socket_Type       ;
    udp_Socket    : Socket_Type       ;


-- ------------------------------------------------------------------------ --
----                        TCP/IP Controller Task                        ----
----                                                                      ----
----  dispatches server task to handle tcp/ip services.                   ----
----                                                                      ----
-- ------------------------------------------------------------------------ --

    task Controller is
        entry Initialize_Controller ;
      end Controller  ;


    task body Controller is

        Selector      : Selector_Type   ;
        Server_Status : Selector_Status ;

        --  Exception_Fds is not use in Ada 95
        --  and is optional Ada 2005 GNAT.Sockets

        Read_Fds      : Socket_Set_Type ;
        Write_Fds     : Socket_Set_Type ;


      begin -- Controller 
          --
          -- Set up controller variables
          --
          Create_Selector ( Selector ) ;
          Empty ( Read_Fds ) ;
          Empty ( Write_Fds ) ;


          Accept Initialize_Controller ;

          --
          -- Set up and active Server
          --
          Put_Line ( "Controller: Server Dispatching Loop" ) ;
          loop
            -- Insure Fds value, 
            Empty ( Read_Fds ) ;
            Empty ( Write_Fds ) ;

            Set ( Read_Fds, tcp_Socket ) ;
            Set ( Read_Fds, udp_Socket ) ;

            --
            --  Excute the TCP/IP "Select" routine.  This routine is blocked
            --  until a connecion is made. In this part it is identical to 
            --  TCP/IP "Accept".
            --
            --  Also, Exception_Fds is not use in Ada 95 and is optional 
            --  Ada 2005 GNAT.Sockets
            --
            Check_Selector ( Selector, 
                             Read_Fds, 
                             Write_Fds, 
                             Server_Status ) ;

            -- call a server to handle job using Signalling Fds

            if Is_Set ( Read_Fds, tcp_Socket ) then
                tcp_hello.Acknowledge ;
            elsif Is_Set ( Read_Fds, udp_Socket ) then
                udp_hello.Acknowledge ;
            else
              raise Socket_Error ;
            end if ;
          end loop ;
       exception
         when Socket_Error => 
             -- need to signal servers to shutdown because 
             -- dispatcher has stopped
             raise ;            
      end Controller  ;




-- ------------------------------------------------------------------------ --
----                         TCP/IP Server Tasks                          ----
----                                                                      ----
----  Both tasks are similar.  They both send a message to a client       ----
----  Differences:                                                        ----
----        1) Transport protocols: One uses TCP, the other uses UDP      ----
----        2) Message and message length                                 ----
----                                                                      ----
----  Excution of these two servers will cause the "netstat" program      ----
----  to add the following info to the "netstat" socket report            ----
----                                                                      ----
----      IP Address        protocol    port                              ----
----      127.0.0.1         tcp         54321                             ----
----      127.0.0.1         udp         54321                             ----
----                                                                      ----
-- ------------------------------------------------------------------------ --



    task body tcp_hello is

        Port         : constant Port_Type := 54321 ;

        Address      : Sock_Addr_Type    ;
        Channel      : Stream_Access     ;
        Client       : Socket_Type       ; 

        hello_string : String ( 1..25 ) := "TCP Server: Hello, World!" ; 

      begin -- Tcp_hello

        Create_Socket ( tcp_Socket, Family_Inet, Socket_Stream ) ;
        --
--        Address.Addr := Any_Inet_Addr ;
        Address.Addr := Inet_Addr ( "127.0.0.1" ) ; -- Limited access
        Address.Port := Port ;
        --
        Bind_Socket ( tcp_Socket, Address ) ;

        --
        Listen_Socket ( tcp_Socket, 4 ) ;  

        Accept Initialize ;
        --
        --  Main Server processing routine 
        --
        Put_Line ( "TCP: Active the Server loop" ) ;
        loop 
          accept Acknowledge ;

          -- ------------------------ --
          --  Do server services job  --
          -- ------------------------ --

          --
          --  Because of Check_Selector, no wait for Accept_Socket
          --  used to obtain connected socket ( Client ) address 
          --  for the tcp protocol.
          --
          Accept_Socket ( tcp_Socket, Client, Address ) ;

          Channel := Stream ( Client ) ;

          String'Write ( Channel, hello_string ) ;

          Close_Socket ( Client ) ;

        end loop ;

        --
        -- for security, close socket if exception occured
        --
        exception
          when others =>
              Put_Line ( "TCP: Exception" ) ;
              Close_Socket ( tcp_Socket ) ;
              raise ;
      end tcp_hello ;



    -- 
    --  UDP Task
    -- 

    task body udp_hello is

        Port           : constant Port_Type := 54321 ;

        Address        : Sock_Addr_Type    ;
        Channel_Input  : Stream_Access     ;
        Channel_Output : Stream_Access     ;

        Temp           : Character         ;
        hello_string : String := "UDP Server: Repeat Hello, World!" ; 

      begin -- udp_hello

        Create_Socket ( udp_Socket, Family_Inet, Socket_Datagram ) ;
        --
--        Address.Addr := Any_Inet_Addr ;
        Address.Addr := Inet_Addr ( "127.0.0.1" ) ;
        Address.Port := Port ;
        --
        Bind_Socket ( udp_Socket, Address ) ;


        Accept Initialize ;
        --
        --  Main Server processing routine 
        --
        Put_Line ( "UDP: Active the Server loop" ) ;
        loop 
          accept Acknowledge ;

          -- ------------------------ --
          --  Do server services job  --
          -- ------------------------ --
                                           -- Accept from any Address and Port
          Address.Addr := Any_Inet_Addr ;
          Address.Port := Any_Port ;

          Channel_Input := Stream ( udp_Socket, Address ) ;  
      
          Character'Read ( Channel_Input, Temp ) ;

                                           -- Open an output channel
          Address := Get_Address ( Channel_Input ) ;
          Channel_Output := Stream ( udp_Socket, Address ) ;

          String'Write ( Channel_Output, hello_string ) ;
        end loop ;

        --
        -- for security, close socket if exception occured
        --
        exception
          when others =>
              Put_Line ( "UDP: Exception" ) ;
              Close_Socket ( udp_Socket ) ;
              raise ;
      end udp_hello ;



                      -- ------------------------ --
                      ----   Server Initiaizer  ----
                      -- ------------------------ --



  begin

    -- Initialize each server service task

    tcp_hello.Initialize ;
    udp_hello.Initialize ;

    --  Startup network controller

    Controller.Initialize_Controller ;

  --
  -- Handle all exceptions
  --
  exception 
    when Socket_Error =>
      raise ;
    when others =>
      raise ;
  end testserver ;





-- ----------------------------------------------------- --
-- Non-Tasking Client that test the Multi-Service Server --
-- ----------------------------------------------------- --

with Ada.Command_Line ;
with Ada.Text_IO ;
with Ada.Unchecked_Conversion ;
with GNAT.Sockets ;

use  Ada.Command_Line ;
use  Ada.Text_IO ;
use  GNAT.Sockets ;

procedure testclient is 

    localhost : constant Inet_Addr_Type := Inet_Addr ( "127.0.0.1" ) ;
    localport : constant Port_Type := 54321 ;
    --
    Address : Sock_Addr_Type    ;
    Channel : Stream_Access     ;
    Socket  : Socket_Type       ;
    --
    tcp_Buffer  : String ( 1..25 )  ;
    udp_Buffer  : String ( 1..32 )  ;

  begin -- Daytime0

    --
    Address.Addr := localhost ;
    Address.Port := localport ;

    --
    if Argument ( 1 ) = "-T" then
      Put_Line ( "Protocol: TCP" ) ;
      --
      Create_Socket ( Socket, Family_Inet, Socket_Stream ) ;
      Connect_Socket ( Socket, Address ) ;
      --
      Channel := Stream ( Socket ) ;
      String'Read ( Channel, tcp_Buffer ) ;
      --
      Close_Socket ( Socket ) ;
      --
      Put ( "Server Data => " ) ;
      Put ( tcp_Buffer ) ;
      Put ( " <= " ) ;
      New_Line ;

    elsif Argument ( 1 ) = "-U" then
      Put_Line ( "Protocol: UDP" ) ;
      --
      Create_Socket ( Socket, Family_Inet, Socket_Datagram ) ;
      Channel := Stream ( Socket, Address ) ;

      -- Allows server to obtain client address by send a dummy character 

      Character'Write ( Channel, Ascii.nul ) ; 
      --
      Channel := Stream ( Socket, Address ) ;
      String'Read ( Channel, udp_Buffer ) ;
      --
      Close_Socket ( Socket ) ;
      --
      Put ( "Server Data => " ) ;
      Put ( udp_Buffer ) ;
      Put ( " <= " ) ;
      New_Line ;

     else
      Put_Line ( Standard_Error, "usage: testclient [-DT]" ) ;
      Put_Line ( Standard_Error, "-T: tcp" ) ;
      Put_Line ( Standard_Error, "-U: udp" ) ;
      New_Line ;
    end if ;
  end testclient ;