comp.lang.ada
 help / color / mirror / Atom feed
* Recursive Protected types getting deadlocked! (longish)
@ 1997-09-07  0:00 Dale Stanbrough
  1997-09-08  0:00 ` Robert A Duff
                   ` (2 more replies)
  0 siblings, 3 replies; 4+ messages in thread
From: Dale Stanbrough @ 1997-09-07  0:00 UTC (permalink / raw)



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;




^ permalink raw reply	[flat|nested] 4+ messages in thread
end of thread, other threads:[~1997-09-10  0:00 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
1997-09-07  0:00 Recursive Protected types getting deadlocked! (longish) Dale Stanbrough
1997-09-08  0:00 ` Robert A Duff
1997-09-08  0:00 ` Tucker Taft
1997-09-10  0:00 ` Robert Dewar

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox