Suspicious reentrant semaphore

Suspicious reentrant semaphore

[Jano]

Hello everybody,

I'm developing a multitasking program that runs OK for several hours. At 
some indeterminate moment, a bunch of its tasks cease to respond, and I 
have a strong suspicion that the culprit is a semaphore package I've 
done.

The purpose is to have a semaphore which can be called more than a time 
_by the same task_, and that must be released the same amount of times. 
Nested calls, simply.

Leaving aside why I have done that (yes, poor design, I'm removing it 
anyway ;-), I would like to know if my package is right or really is 
there some race condition. Please comment on it. I know that 
Current_Task shouldn't be called inside entries (in fact Gnat doesn't 
allow it, I tried :-P) but doesn't complain about it being used in 
barriers. Anyways, I have a (maybe wrong) feel about that being related 
to the deadlock.

Here are the spec and body:

P.s: I can guarantee that never use it without the controlled object, so 
no calls to V should occur without a previous P.

P.s: If it turns out that this isn't the culprit, I will amuse you ;-) 
with more samples of my code ^_^

Thanks!

------------SPEC---------------------------------------------------

package Adagio.Monitor is

   use Ada.Task_identification;
   
   protected type Semaphore is
      entry P (Owner : Task_id);
      entry V;
   private
      Caller : Task_id := Null_task_id;           -- Requester
      In_use : Natural := 0;                      -- Times requested
   end Semaphore;

   type Semaphore_access is access all Semaphore;

   -- Use: 
   -- S : aliased Semaphore;
   -- M : Object (S'access);
   type Object (S : access Semaphore) is new 
      Finalization.Limited_Controlled with null record;

   procedure Initialize (this : in out Object);
   procedure Finalize   (this : in out Object);

end Adagio.Monitor;

---------------------BODY----------------------------------

package body Adagio.Monitor is

   protected body Semaphore is

      entry P (Owner: Task_id) 
         when In_use = 0 or else Current_task = Caller is
      begin
         Caller := Owner;
         In_use := In_use + 1;
      end P;

      entry V when In_use > 0 and Current_task = Caller is
      begin
         In_use := In_use - 1;
      end V;

   end Semaphore;

   -- Get
   procedure Initialize (this : in out Object) is
   begin
      this.S.P (Current_task);
   end Initialize;

   -- Release
   procedure Finalize (this : in out Object) is
   begin
      this.S.V;
   end Finalize;

end Adagio.Monitor;

-- 
-------------------------
Jano
402450.at.cepsz.unizar.es
-------------------------

Re: Suspicious reentrant semaphore

[Dmitry A. Kazakov]

Jano wrote:

> I'm developing a multitasking program that runs OK for several hours. At
> some indeterminate moment, a bunch of its tasks cease to respond, and I
> have a strong suspicion that the culprit is a semaphore package I've
> done.
> 
> The purpose is to have a semaphore which can be called more than a time
> _by the same task_, and that must be released the same amount of times.
> Nested calls, simply.
> 
> Leaving aside why I have done that (yes, poor design, I'm removing it
> anyway ;-), I would like to know if my package is right or really is
> there some race condition. Please comment on it. I know that
> Current_Task shouldn't be called inside entries (in fact Gnat doesn't
> allow it, I tried :-P) but doesn't complain about it being used in
> barriers. Anyways, I have a (maybe wrong) feel about that being related
> to the deadlock.

The requeue statement does the trick in case you want to use a parameter 
value in a barrier. You could add one more private entry and requeue to it 
if the task is not the owner:

entry P (Owner: Task_id) when True is
begin
   if Caller = Owner then
      In_use := In_use + 1;
   else
      requeue Alien_P with abort;
   end if;
end P;

entry Alien_P (Owner: Task_id) when In_use = 0 is
begin
   Caller := Owner;
   In_use := 1;
end Alien_P;

-- 
Regards,
Dmitry A. Kazakov
www.dmitry-kazakov.de

Re: Suspicious reentrant semaphore

[Ian Broster]

> it. I know that Current_Task shouldn't be called inside entries
> (in fact Gnat doesn't allow it, I tried :-P) but doesn't

Last time I (accidentally!) checked, GNAT `allowed' you to use
it in a PO, but gave a different result to what you might
be expecting. 

ian

Re: Suspicious reentrant semaphore

[Randy Brukardt]

Jano wrote in message ...
>Hello everybody,
>Leaving aside why I have done that (yes, poor design, I'm removing it
>anyway ;-), I would like to know if my package is right or really is
>there some race condition. Please comment on it. I know that
>Current_Task shouldn't be called inside entries (in fact Gnat doesn't
>allow it, I tried :-P) but doesn't complain about it being used in
>barriers. Anyways, I have a (maybe wrong) feel about that being related
>to the deadlock.


Why don't you use the attribute defined for this purpose? E'Caller
returns the task-id of the caller.

Claw uses a lock much like this one, and it uses E'Caller, not
Current_Task (which may not be the caller).

Here's the body of the "Get" entry from Claw:

        entry Get when True is
            use type Ada.Task_Identification.Task_Id;
        begin
            if Use_Count = 0 then
                Owner_Task_Id := Get'Caller;
                Use_Count := 1;
            elsif Owner_Task_Id = Get'Caller then
                Use_Count := Use_Count + 1;
            else
                requeue Wait_for_Free with abort; -- Let any timeouts
expire.
            end if;
        end Get;

And Wait_for_Free looks like:

        entry Wait_for_Free when Use_Count = 0 is
        begin
            Owner_Task_Id := Wait_for_Free'Caller;
            Use_Count := 1;
        end Wait_for_Free;

           Randy Brukardt.

Re: Suspicious reentrant semaphore

[Peter Richtmyer]

"Randy Brukardt" <randy@rrsoftware.com> wrote in message news:<vb02ga5bun2lcc@corp.supernews.com>...
> 
>         entry Get when True is

I'm curious, why the "when True" above ?

thanks,
Peter

Re: Suspicious reentrant semaphore

[Simon Wright]

prichtmyer@yahoo.com (Peter Richtmyer) writes:

> "Randy Brukardt" <randy@rrsoftware.com> wrote in message news:<vb02ga5bun2lcc@corp.supernews.com>...
> > 
> >         entry Get when True is
> 
> I'm curious, why the "when True" above ?

It has to be an entry so that it can be requeued if it turns out to be
necessary to do so, but it's one that needs to be accepted
unconditionally.

You use this style when the logical guard (the one you want to write)
can't be expressed in the language as a guard..

Re: Suspicious reentrant semaphore

[Jano]

Dmitry A. Kazakov dice...
> The requeue statement does the trick in case you want to use a parameter 
> value in a barrier. You could add one more private entry and requeue to it 
> if the task is not the owner:

Dmitry: I love this suggestion specially because is the first time I'm 
going to employ requeue (never before I faced the necessity).

Here is the new version of my package. I've also slightly changed the 
release logic to obtain exceptions instead of deadlocks in case of wrong 
use:

---------------- SPEC ---------------------

with Ada.Finalization;        use Ada;
with Ada.Task_identification;

package Adagio.Monitor is

   use Ada.Task_identification;

   Use_error : Exception;
   
   protected type Semaphore is

      entry     P (Owner : Task_id);
      procedure V (Owner : Task_id);

   private

      entry Safe_P (Owner : Task_id);

      Caller : Task_id := Null_task_id;           -- Requester
      In_use : Natural := 0;                      -- Times requested

   end Semaphore;

   type Semaphore_access is access all Semaphore;

   -- Use: 
   -- S : aliased Semaphore;
   -- declare
   --   M : Object(S'access);
   -- begin
   --   Exclusive_work;
   -- end;
   type Object (S : access Semaphore) is new 
      Finalization.Limited_Controlled with null record;

   procedure Initialize (this : in out Object);
   procedure Finalize   (this : in out Object);

end Adagio.Monitor;

------------------ BODY -----------------------

package body Adagio.Monitor is

   protected body Semaphore is

      entry P (Owner : Task_id) when true is
      begin
         if Owner = Caller then
            In_use := In_use + 1;
         else
            requeue Safe_P with abort;
         end if;
      end P;

      entry Safe_P (Owner : Task_id) when In_use = 0 is
      begin
         Caller := Owner;
         In_use := 1;
      end Safe_P;

      procedure V (Owner : Task_id) is
      begin
         if Owner /= Caller then
            raise Use_error;
         else
            In_use:= In_use - 1;
            if In_use = 0 then
               Caller := Null_task_id;
            end if;
         end if;
      end V;

   end Semaphore;

   -- Get
   procedure Initialize(this: in out Object) is
   begin
      this.S.P (Current_task);
   end Initialize;

   -- Release
   procedure Finalize(this: in out Object) is
   begin
      this.S.V (Current_task);
   end Finalize;

end Adagio.Monitor;

-- 
-------------------------
Jano
402450.at.cepsz.unizar.es
-------------------------

Re: Suspicious reentrant semaphore

[Jano]

Ian Broster dice...
> > it. I know that Current_Task shouldn't be called inside entries
> > (in fact Gnat doesn't allow it, I tried :-P) but doesn't
> 
> Last time I (accidentally!) checked, GNAT `allowed' you to use
> it in a PO, but gave a different result to what you might
> be expecting. 

My test was with 3.15p NT, not a warning but a error.

-- 
-------------------------
Jano
402450.at.cepsz.unizar.es
-------------------------

Re: Suspicious reentrant semaphore

[Jano]

Randy Brukardt dice...
> Jano wrote in message ...
> >Hello everybody,
> >Leaving aside why I have done that (yes, poor design, I'm removing it
> >anyway ;-), I would like to know if my package is right or really is
> >there some race condition. Please comment on it. I know that
> >Current_Task shouldn't be called inside entries (in fact Gnat doesn't
> >allow it, I tried :-P) but doesn't complain about it being used in
> >barriers. Anyways, I have a (maybe wrong) feel about that being related
> >to the deadlock.
> 
> 
> Why don't you use the attribute defined for this purpose? E'Caller
> returns the task-id of the caller.

Thanks, Randy. I didn't remembered of that attribute.

I'm studying your example right now.

-- 
-------------------------
Jano
402450.at.cepsz.unizar.es
-------------------------

Re: Suspicious reentrant semaphore

[Dmitry A. Kazakov]

Jano wrote:

> Dmitry A. Kazakov dice...
>> The requeue statement does the trick in case you want to use a parameter
>> value in a barrier. You could add one more private entry and requeue to
>> it if the task is not the owner:
> 
> Dmitry: I love this suggestion specially because is the first time I'm
> going to employ requeue (never before I faced the necessity).

It is one of the most interesting things added to Ada 95!

> Here is the new version of my package. I've also slightly changed the
> release logic to obtain exceptions instead of deadlocks in case of wrong
> use:

You can also get rid of the task-id parameter, as Randy Brukardt has 
suggested. Sort of:

entry P when true is
begin
   if Owner = P'Caller then
      In_use := In_use + 1;
   else
      requeue Safe_P with abort;
   end if;
end P;
 
entry Safe_P when In_use = 0 is
begin
   Owner := Safe_P'Caller;
   In_use := 1;
end Safe_P;
 
procedure V is
begin
   if Owner /= Current_Task then
      raise Use_error;
   else
      In_use:= In_use - 1;
      if In_use = 0 then
         Owner := Null_task_id;
      end if;
   end if;
end V;

-- 
Regards,
Dmitry A. Kazakov
www.dmitry-kazakov.de

Re: Suspicious reentrant semaphore

[Jano]

Dmitry A. Kazakov dice...
> You can also get rid of the task-id parameter, as Randy Brukardt has 
> suggested.

Yes, I've also done that. I suspect that now my package resembles 
closely that in CLAW. I should have been started there... :D but I have 
not CLAW, though.

-- 
-------------------------
Jano
402450.at.cepsz.unizar.es
-------------------------

Re: Suspicious reentrant semaphore

[tmoran]

>closely that in CLAW. I should have been started there... :D but I have
>not CLAW, though.
  www.rrsoftware.com has a free version, which contains a lot of
task/lock/etc handling code in claw.adb

Re: Suspicious reentrant semaphore

[Michal Morawski]

Does it works in GNAT?

I have written the following program, which cannot be compiled because the
construction "then abort" is not understand by the compiler.

I expect the result:
**..
**..
....
....
Am I right?


with Ada.Text_IO;                         use Ada.Text_IO;

procedure Ins_Requeue is

   protected I is
      entry E1 (X, Y : Integer);
      entry E2 (X, Y : Integer);
      entry E3;
   private
      E1_X, E1_Y,
      E2_X, E2_Y : Integer;
   end I;

   protected body I is
      entry E1 (X, Y : Integer) when True is
      begin
         E1_X := X;
         E1_Y := Y;
         requeue E3 then abort;
************^^ Here is error
      end E1;

      entry E2 (X, Y : Integer) when True is
      begin
         E2_X := X;
         E2_Y := Y;
         requeue E3 then abort;
      end E2;

      entry E3 when E1_X < E2_X and E1_Y < E2_Y is
      begin
         Put ('*');
      end E3;
   end I;

begin
   I.E1 (3, 3);
   for x in 1 .. 4 loop
      for y in 1 .. 4 loop
         select
            I.E2 (x, y);
         else
            Put ('.');
         end select;
      end loop;
      New_Line;
   end loop;
end Ins_Requeue;


-- 
Michal Morawski

"Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> wrote in message
news:b8t6ik$d4egi$1@ID-77047.news.dfncis.de...
> Jano wrote:
>
> > Dmitry A. Kazakov dice...
> >> The requeue statement does the trick in case you want to use a
parameter
> >> value in a barrier. You could add one more private entry and requeue to
> >> it if the task is not the owner:
> >
> > Dmitry: I love this suggestion specially because is the first time I'm
> > going to employ requeue (never before I faced the necessity).
>
> It is one of the most interesting things added to Ada 95!
>
> > Here is the new version of my package. I've also slightly changed the
> > release logic to obtain exceptions instead of deadlocks in case of wrong
> > use:
>
> You can also get rid of the task-id parameter, as Randy Brukardt has
> suggested. Sort of:
>
> entry P when true is
> begin
>    if Owner = P'Caller then
>       In_use := In_use + 1;
>    else
>       requeue Safe_P with abort;
>    end if;
> end P;
>
> entry Safe_P when In_use = 0 is
> begin
>    Owner := Safe_P'Caller;
>    In_use := 1;
> end Safe_P;
>
> procedure V is
> begin
>    if Owner /= Current_Task then
>       raise Use_error;
>    else
>       In_use:= In_use - 1;
>       if In_use = 0 then
>          Owner := Null_task_id;
>       end if;
>    end if;
> end V;
>
> -- 
> Regards,
> Dmitry A. Kazakov
> www.dmitry-kazakov.de

Re: Suspicious reentrant semaphore

[Simon Wright]

"Michal Morawski" <morawski@zsk.p.lodz.pl> writes:

> Does it works in GNAT?
> 
> I have written the following program, which cannot be compiled
> because the construction "then abort" is not understand by the
> compiler.

It would really really help if you included the compiler's error
messages!

Re: Suspicious reentrant semaphore

[Jano]

Michal Morawski dice...
> Does it works in GNAT?
> 
> I have written the following program, which cannot be compiled because the
> construction "then abort" is not understand by the compiler.
> 

>          requeue E3 then abort;
> ************^^ Here is error

I think it's "requeue with abort". "then abort" is used in the ATC 
statement.

-- 
-------------------------
Jano
402450.at.cepsz.unizar.es
-------------------------

Re: Suspicious reentrant semaphore

[Micha� Morawski]

But of course - my mistake "then", "with" Is it similar? No! Am I blind?
Yes!
Thank You

-- 

"Jano" <nono@celes.unizar.es> wrote in message
news:MPG.1920c5beeb9916469896f6@News.CIS.DFN.DE...
> Michal Morawski dice...
> > Does it works in GNAT?
> >
> > I have written the following program, which cannot be compiled because
the
> > construction "then abort" is not understand by the compiler.
> >
>
> >          requeue E3 then abort;
> > ************^^ Here is error
>
> I think it's "requeue with abort". "then abort" is used in the ATC
> statement.
>
> -- 
> -------------------------
> Jano
> 402450.at.cepsz.unizar.es
> -------------------------