File : bc-containers-rings-unbounded-synchronized.adb


-- Copyright (C) 1994-1999 Grady Booch and Simon Wright.
-- All Rights Reserved.
--
--      This program is free software; you can redistribute it
--      and/or modify it under the terms of the Ada Community
--      License which comes with this Library.
--
--      This program is distributed in the hope that it will be
--      useful, but WITHOUT ANY WARRANTY; without even the implied
--      warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
--      PURPOSE. See the Ada Community License for more details.
--      You should have received a copy of the Ada Community
--      License with this library, in the file named "Ada Community
--      License" or "ACL". If not, contact the author of this library
--      for a copy.
--

-- $Id: bc-containers-rings-unbounded-synchronized.adb,v 1.1.2.4 1999/12/31 15:06:55 simon Exp $

with System;

package body BC.Containers.Rings.Unbounded.Synchronized is

  -- I am assured that it's OK to suppress the 'not referenced'
  -- warnings about the Lock variables; there has been an AI (XXX))
  -- stating that a compiler may not optimize away the initialization
  -- and finalization of such variables so long as they are limited.
  -- sjw 13.iv.99

  function "=" (Left, Right : in Synchronized_Unbounded_Ring) return Boolean is
    use type System.Address;
  begin
    -- Avoid possible deadly embrace by enforcing the order of
    -- locking.  Synchronized_Unbounded_Ring is tagged and therefore
    -- passed by reference, so we are comparing addresses of the
    -- actual objects.
    if Left'Address = Right'Address then
      return True;
    elsif Left'Address > Right'Address then
      return Right = Left;
    else
      declare
        Left_Lock : BC.Support.Synchronization.Read_Lock (Left.The_Monitor);
        pragma Warnings (Off, Left_Lock);
        Right_Lock : BC.Support.Synchronization.Read_Lock (Right.The_Monitor);
        pragma Warnings (Off, Right_Lock);
      begin
        return "=" (Unbounded_Ring (Left), Unbounded_Ring (Right));
      end;
    end if;
  end "=";

  procedure Clear (R : in out Synchronized_Unbounded_Ring) is
    Region : BC.Support.Synchronization.Lock (R.Critical_Region);
    pragma Warnings (Off, Region);
    Lock : BC.Support.Synchronization.Write_Lock (R.The_Monitor);
    pragma Warnings (Off, Lock);
  begin
    if Extent (Unbounded_Ring (R)) > 0 then
      BC.Support.Synchronization.Seize (R.Producer_Consumer.all);
    end if;
    Clear (Unbounded_Ring (R));
  end Clear;

  procedure Insert (R : in out Synchronized_Unbounded_Ring; Elem : Item) is
    Lock : BC.Support.Synchronization.Write_Lock (R.The_Monitor);
    pragma Warnings (Off, Lock);
  begin
    if Extent (Unbounded_Ring (R)) = 0 then
      BC.Support.Synchronization.Release (R.Producer_Consumer.all);
    end if;
    Insert (Unbounded_Ring (R), Elem);
  end Insert;

  procedure Pop (R : in out Synchronized_Unbounded_Ring) is
    Region : BC.Support.Synchronization.Lock (R.Critical_Region);
    pragma Warnings (Off, Region);
  begin
    BC.Support.Synchronization.Seize (R.Producer_Consumer.all);
    declare
      Lock : BC.Support.Synchronization.Write_Lock (R.The_Monitor);
      pragma Warnings (Off, Lock);
    begin
      if Extent (Unbounded_Ring (R)) > 1 then
        BC.Support.Synchronization.Release (R.Producer_Consumer.all);
      end if;
      Pop (Unbounded_Ring (R));
    end;
  end Pop;

  procedure Pop_Value (R : in out Synchronized_Unbounded_Ring;
                       Elem : out Item) is
    Region : BC.Support.Synchronization.Lock (R.Critical_Region);
    pragma Warnings (Off, Region);
  begin
    BC.Support.Synchronization.Seize (R.Producer_Consumer.all);
    declare
      Lock : BC.Support.Synchronization.Write_Lock (R.The_Monitor);
      pragma Warnings (Off, Lock);
    begin
      if Extent (Unbounded_Ring (R)) > 1 then
        BC.Support.Synchronization.Release (R.Producer_Consumer.all);
      end if;
      Elem := Top(Unbounded_Ring (R));
      Pop (Unbounded_Ring (R));
    end;
  end Pop_Value;

  procedure Rotate (R : in out Synchronized_Unbounded_Ring;
                    Dir : Direction := Forward) is
    Lock : BC.Support.Synchronization.Write_Lock (R.The_Monitor);
    pragma Warnings (Off, Lock);
  begin
    Rotate (Unbounded_Ring (R), Dir);
  end Rotate;

  procedure Mark (R : in out Synchronized_Unbounded_Ring) is
    Lock : BC.Support.Synchronization.Write_Lock (R.The_Monitor);
    pragma Warnings (Off, Lock);
  begin
    Mark (Unbounded_Ring (R));
  end Mark;

  procedure Rotate_To_Mark (R : in out Synchronized_Unbounded_Ring) is
    Lock : BC.Support.Synchronization.Write_Lock (R.The_Monitor);
    pragma Warnings (Off, Lock);
  begin
    Rotate_To_Mark (Unbounded_Ring (R));
  end Rotate_To_Mark;

  function Extent (R : Synchronized_Unbounded_Ring) return Natural is
    Lock : BC.Support.Synchronization.Read_Lock (R.The_Monitor);
    pragma Warnings (Off, Lock);
  begin
    return Extent (Unbounded_Ring (R));
  end Extent;

  function Is_Empty (R : Synchronized_Unbounded_Ring) return Boolean is
    Lock : BC.Support.Synchronization.Read_Lock (R.The_Monitor);
    pragma Warnings (Off, Lock);
  begin
    return Is_Empty (Unbounded_Ring (R));
  end Is_Empty;

  function Top (R : Synchronized_Unbounded_Ring) return Item is
    Lock : BC.Support.Synchronization.Read_Lock (R.The_Monitor);
    pragma Warnings (Off, Lock);
  begin
    return Top (Unbounded_Ring (R));
  end Top;

  function At_Mark (R : Synchronized_Unbounded_Ring) return Boolean is
    Lock : BC.Support.Synchronization.Read_Lock (R.The_Monitor);
    pragma Warnings (Off, Lock);
  begin
    return At_Mark (Unbounded_Ring (R));
  end At_Mark;

  procedure Lock (R : in out Synchronized_Unbounded_Ring) is
  begin
    BC.Support.Synchronization.Seize_For_Reading (R.The_Monitor.all);
  end Lock;

  procedure Unlock (R : in out Synchronized_Unbounded_Ring) is
  begin
    BC.Support.Synchronization.Release_From_Reading (R.The_Monitor.all);
  end Unlock;

  procedure Initialize (R : in out Synchronized_Unbounded_Ring) is
  begin
    Initialize (Unbounded_Ring (R));
    R.The_Monitor := new Monitor;
    R.Producer_Consumer := new BC.Support.Synchronization.Semaphore;
    R.Critical_Region := new BC.Support.Synchronization.Semaphore;
    BC.Support.Synchronization.Seize (R.Producer_Consumer.all);
  end Initialize;

  procedure Adjust (R : in out Synchronized_Unbounded_Ring) is
    -- Consider R := P;
    -- On entry to Adjust, R contains a bitwise copy of P, so that
    -- R.The_Monitor points to the same Monitor as P.The_Monitor.
    -- XXX Perhaps Adjust should use a lock variable? to ensure it's
    -- released even if an exception occurs.
  begin
    -- lock P's monitor
    Lock (R);
    -- make the deep copy
    Adjust (Unbounded_Ring (R));
    -- unlock P's monitor
    Unlock (R);
    -- create new monitor, semaphores for R
    R.The_Monitor := new Monitor;
    R.Producer_Consumer := new BC.Support.Synchronization.Semaphore;
    R.Critical_Region := new BC.Support.Synchronization.Semaphore;
    if Extent (Unbounded_Ring (R)) = 0 then
      BC.Support.Synchronization.Seize (R.Producer_Consumer.all);
    end if;
  end Adjust;

  procedure Finalize (R : in out Synchronized_Unbounded_Ring) is
  begin
    BC.Support.Synchronization.Delete (R.The_Monitor);
    BC.Support.Synchronization.Delete (R.Producer_Consumer);
    BC.Support.Synchronization.Delete (R.Critical_Region);
    Finalize (Unbounded_Ring (R));
  end Finalize;

end BC.Containers.Rings.Unbounded.Synchronized;