File : bc-support-synchronization.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-support-synchronization.adb,v 1.1.2.3 1999/05/29 16:12:57 simon Exp $
with Ada.Unchecked_Deallocation;
package body BC.Support.Synchronization is
-- Semaphore_Base --
procedure Delete (The_Semaphore : in out Semaphore_P) is
procedure Free is new Ada.Unchecked_Deallocation
(Semaphore_Base'Class, Semaphore_P);
begin
Free (The_Semaphore);
end Delete;
-- Semaphore --
protected body Semaphore_Type is
entry Seize when True is
use type Ada.Task_Identification.Task_Id;
begin
-- Why do I say Semaphore_Type.Seize rather than just Seize?
--
-- Jean-Pascal Cozic <Jean-Pascal.Cozic@ingsud.dga.fr> says:
-- You have to write Semaphore_Type.Seize'Caller because there
-- are two homographs Seize in the scope (the entry and the
-- procedure). Using the context, there is no ambiguity because
-- Caller deals with a prefix that denotes an entry_declaration,
-- but the compiler cannot use context in this case.
--
-- See LRM 4.1.4(14).
if Owner = Semaphore_Type.Seize'Caller then
Count := Count + 1;
else
requeue Waiting with abort;
end if;
end Seize;
procedure Release is
begin
Count := Count - 1;
end Release;
function None_Pending return Boolean is
begin
return Waiting'Count = 0;
end None_Pending;
entry Waiting when Count = 0 is
begin
Owner := Waiting'Caller;
Count := 1;
end Waiting;
end Semaphore_Type;
procedure Initialize (The_Semaphore : in out Semaphore) is
begin
The_Semaphore.S := new Semaphore_Type;
end Initialize;
procedure Finalize (The_Semaphore : in out Semaphore) is
procedure Free is new Ada.Unchecked_Deallocation
(Semaphore_Type, Semaphore_Type_P);
begin
Free (The_Semaphore.S);
end Finalize;
procedure Seize (The_Semaphore : in out Semaphore) is
begin
The_Semaphore.S.Seize;
end Seize;
procedure Release (The_Semaphore : in out Semaphore) is
begin
The_Semaphore.S.Release;
end Release;
function None_Pending (On_The_Semaphore : Semaphore) return Boolean is
begin
return On_The_Semaphore.S.None_Pending;
end None_Pending;
-- Monitor --
procedure Delete (The_Monitor : in out Monitor_P) is
procedure Free is new Ada.Unchecked_Deallocation
(Monitor_Base'Class, Monitor_P);
begin
Free (The_Monitor);
end Delete;
-- Single_Monitor --
procedure Seize_For_Reading (The_Monitor : in out Single_Monitor) is
begin
Seize (The_Monitor.The_Semaphore);
end ;
procedure Seize_For_Writing (The_Monitor : in out Single_Monitor) is
begin
Seize (The_Monitor.The_Semaphore);
end ;
procedure Release_From_Reading (The_Monitor : in out Single_Monitor) is
begin
Release (The_Monitor.The_Semaphore);
end ;
procedure Release_From_Writing (The_Monitor : in out Single_Monitor) is
begin
Release (The_Monitor.The_Semaphore);
end ;
-- Multiple_Monitor --
protected body Monitor_Type is
entry Seize (Kind : in Seize_Kind)
when Waiting_To_Write'Count = 0 and not Writing is
begin
case Kind is
when For_Reading =>
Reader_Count := Reader_Count + 1;
when For_Writing =>
requeue Waiting_To_Write;
end case;
end Seize;
procedure Release_For_Reading is
begin
Reader_Count := Reader_Count - 1;
end;
procedure Release_For_Writing is
begin
Writing := False;
end;
entry Waiting_To_Write when Reader_Count = 0 is
begin
Writing := True;
end;
end Monitor_Type;
procedure Seize_For_Reading (The_Monitor : in out Multiple_Monitor) is
begin
The_Monitor.M.Seize (Kind => For_Reading);
end ;
procedure Seize_For_Writing (The_Monitor : in out Multiple_Monitor) is
begin
The_Monitor.M.Seize (Kind => For_Writing);
end ;
procedure Release_From_Reading (The_Monitor : in out Multiple_Monitor) is
begin
The_Monitor.M.Release_For_Reading;
end ;
procedure Release_From_Writing (The_Monitor : in out Multiple_Monitor) is
begin
The_Monitor.M.Release_For_Writing;
end ;
-- Lock --
procedure Initialize (The_Lock : in out Lock) is
begin
Seize (The_Lock.Using.all);
end ;
procedure Finalize (The_Lock : in out Lock) is
begin
Release (The_Lock.Using.all);
end ;
-- Read_Lock --
procedure Initialize (The_Lock : in out Read_Lock) is
begin
Seize_For_Reading (The_Lock.Using.all);
end ;
procedure Finalize (The_Lock : in out Read_Lock) is
begin
Release_From_Reading (The_Lock.Using.all);
end ;
-- Write_Lock --
procedure Initialize (The_Lock : in out Write_Lock) is
begin
Seize_For_Writing (The_Lock.Using.all);
end ;
procedure Finalize (The_Lock : in out Write_Lock) is
begin
Release_From_Writing (The_Lock.Using.all);
end ;
end BC.Support.Synchronization;