Re: Recursive Protected types getting deadlocked! (longish)

[stt@houdini.camb.inmet.com (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