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;