Recursive Protected types getting deadlocked! (longish)

Recursive Protected types getting deadlocked! (longish)

[Dale Stanbrough]

I've written a small semaphore that records the task id of the owner,
allowing recusive lock taking (i'm looking at how Java tasking works).

The following code seems to deadlock however. It seems that when a
2nd task is woken up on the Queued entry, it does so in the context
of the first Task (or so the Image function tells me...).

This to me seems very strange. Is it likely to be an error in Gnat, 
or is it a misunderstanding on my part as to how this all works...


Dale

-----------------------------
with semaphores; use semaphores;
with ada.task_identification; use ada.task_identification;

procedure main2 is

   a : recursive_semaphore;

   task type wow;

   task body wow is
   begin
      A.Seize ;
      delay 1.0;
      A.Seize ;

      delay 1.0;

      A.release;

      delay 1.0;
      A.release;
  end;

   task_1 : wow;
   task_2 : wow;
    
begin
   null;
end;

-------------------------
with Ada.Task_Identification; use Ada.Task_Identification;
package Semaphores is


    protected type Recursive_Semaphore is
        entry     Seize;
        procedure Release;
    private
        entry Queue;
        Lock_Holder : Task_Id;
        Held        : Natural := 0;
    end Recursive_Semaphore;

end Semaphores;

--------
with text_io; use text_io;

package body Semaphores is
      protected body Recursive_Semaphore is

      -----------
      -- Seize --
      -----------

      entry Seize  when True is
      begin
         Put_Line ("Seize called by ... " & Image (Current_Task));
         put_line ("   owner is " & Image (Lock_Holder));
         if Held /= 0 then
            -- am i requesting it again?
            -- If so then increment the count so we know when
            -- to release it

            if Lock_Holder = Current_Task then
               Put_LIne ("Lock being grabbed by " & Image (Current_Task));
               Held := Held + 1;

               Put_LIne ("held is now " & Held'img);
            else
               Put_Line ( Image (Current_Task) & " requeueing");
               requeue Queue;
            end if;

         else
            Put_Line (Image (Current_Task) & " grabbing lock");
            Held := 1;
            Lock_Holder := Current_Task;
         end if;

      end Seize;


      -------------
      -- Release --
      -------------

      procedure Release is
      begin
         Put_Line ("Release called by " & Image (Current_Task));

         if Held = 0 then
            -- someone tried to release it when it wasn't held!
            raise Tasking_Error;

         elsif Current_Task /= Lock_Holder then
            -- held, but not by me!
            raise Tasking_Error;
         else
            Held := Held - 1;
            Put_Line ("   held is now " & Held'img);
         end if;

      end Release;
       

      -----------
      -- Queue --
      -----------

      --  Queued task manages to get the lock!

      entry Queue when Held = 0 is
      begin
         Put_Line (Image (Current_Task) & " Queue, getting lock");
         Held := 1;
         Lock_Holder := Current_Task;

         put_Line ("image is ...." & Image (Current_Task));
      end Queue;

   end Recursive_Semaphore;

end Semaphores;

Re: Recursive Protected types getting deadlocked! (longish)

[Robert A Duff]

In article <5uu4mr$6fs$1@goanna.cs.rmit.edu.au>,
Dale Stanbrough  <dale@goanna.cs.rmit.EDU.AU> wrote:
>I've written a small semaphore that records the task id of the owner,
>allowing recusive lock taking (i'm looking at how Java tasking works).

I didn't look at all your code, but I think you've violated C.7.1(17).

- Bob

Re: Recursive Protected types getting deadlocked! (longish)

[Tucker Taft]

Dale Stanbrough (dale@goanna.cs.rmit.EDU.AU) wrote:

: I've written a small semaphore that records the task id of the owner,
: allowing recusive lock taking (i'm looking at how Java tasking works).

: The following code seems to deadlock however. It seems that when a
: 2nd task is woken up on the Queued entry, it does so in the context
: of the first Task (or so the Image function tells me...).

: This to me seems very strange. Is it likely to be an error in Gnat, 
: or is it a misunderstanding on my part as to how this all works...

Any "convenient" thread may perform an entry body (RM95 9.5.3(22)).  
This flexibility can be critical to minimizing unnecessary context 
switches and lock transfers.  Hence, asking for "Current_Task" from
inside an entry body is not useful.  If you need to get the 
identity of the thread which initiated an entry call, use 
the 'Caller attribute (C.7.1(14)).

For example, inside Seize you should use "Seize'Caller"
rather than "Current_Task"; inside Release you should use
"Release'Caller".

: Dale

: -----------------------------
: with semaphores; use semaphores;
: with ada.task_identification; use ada.task_identification;

: procedure main2 is

:    a : recursive_semaphore;

:    task type wow;

:    task body wow is
:    begin
:       A.Seize ;
:       delay 1.0;
:       A.Seize ;

:       delay 1.0;

:       A.release;

:       delay 1.0;
:       A.release;
:   end;

:    task_1 : wow;
:    task_2 : wow;
:     
: begin
:    null;
: end;

: -------------------------
: with Ada.Task_Identification; use Ada.Task_Identification;
: package Semaphores is


:     protected type Recursive_Semaphore is
:         entry     Seize;
:         procedure Release;
:     private
:         entry Queue;
:         Lock_Holder : Task_Id;
:         Held        : Natural := 0;
:     end Recursive_Semaphore;

: end Semaphores;

: --------
: with text_io; use text_io;

: package body Semaphores is
:       protected body Recursive_Semaphore is

:       -----------
:       -- Seize --
:       -----------

:       entry Seize  when True is
:       begin
:          Put_Line ("Seize called by ... " & Image (Current_Task));
:          put_line ("   owner is " & Image (Lock_Holder));
:          if Held /= 0 then
:             -- am i requesting it again?
:             -- If so then increment the count so we know when
:             -- to release it

:             if Lock_Holder = Current_Task then
:                Put_LIne ("Lock being grabbed by " & Image (Current_Task));
:                Held := Held + 1;

:                Put_LIne ("held is now " & Held'img);
:             else
:                Put_Line ( Image (Current_Task) & " requeueing");
:                requeue Queue;
:             end if;

:          else
:             Put_Line (Image (Current_Task) & " grabbing lock");
:             Held := 1;
:             Lock_Holder := Current_Task;
:          end if;

:       end Seize;


:       -------------
:       -- Release --
:       -------------

:       procedure Release is
:       begin
:          Put_Line ("Release called by " & Image (Current_Task));

:          if Held = 0 then
:             -- someone tried to release it when it wasn't held!
:             raise Tasking_Error;

:          elsif Current_Task /= Lock_Holder then
:             -- held, but not by me!
:             raise Tasking_Error;
:          else
:             Held := Held - 1;
:             Put_Line ("   held is now " & Held'img);
:          end if;

:       end Release;
:        

:       -----------
:       -- Queue --
:       -----------

:       --  Queued task manages to get the lock!

:       entry Queue when Held = 0 is
:       begin
:          Put_Line (Image (Current_Task) & " Queue, getting lock");
:          Held := 1;
:          Lock_Holder := Current_Task;

:          put_Line ("image is ...." & Image (Current_Task));
:       end Queue;

:    end Recursive_Semaphore;

: end Semaphores;

--
-Tucker Taft   stt@inmet.com   http://www.inmet.com/~stt/
Intermetrics, Inc.  Burlington, MA  USA

Re: Recursive Protected types getting deadlocked! (longish)

[Robert Dewar]

The use of Current_Task within a protected type is bogus, the behavior
you see is legitimate.