File : posix-generic_shared_memory.adb
------------------------------------------------------------------------------
-- --
-- FLORIST (FSU Implementation of POSIX.5) COMPONENTS --
-- --
-- P O S I X . G E N E R I C _ S H A R E D _ M E M O R Y --
-- --
-- B o d y --
-- --
-- --
-- Copyright (c) 1996-1998 Florida State University (FSU), --
-- All Rights Reserved. --
-- --
-- This file is a component of FLORIST, an implementation of an Ada API --
-- for the POSIX OS services, for use with the GNAT Ada compiler and --
-- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended --
-- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD --
-- 1003.5b: 1996. --
-- --
-- FLORIST is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. FLORIST 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 GNU --
-- General Public License for more details. You should have received a --
-- copy of the GNU General Public License distributed with GNARL; see --
-- file COPYING. If not, write to the Free Software Foundation, 59 --
-- Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
------------------------------------------------------------------------------
-- [$Revision: 1.1]
-- See the warnings in the package spec.
-- This package presents potential semantic and implementation
-- problems. We do not want shared objects to be reinitialized for
-- each process that uses them. We do not want shared objects
-- finalized, or at least not until the "last close" of the
-- shared memory object in which they reside.
-- The present implementation makes no attempt to deal correctly
-- with controlled types.
-- It also relies on the assumption that an "access all" pointer
-- is meaningfully unchecked-convertible to an ordinary "access"
-- value.
-- ....
-- This has several critical sections, to give the effect of atomicity
-- from a series of system calls.
-- We have put exception handlers around these, to make sure the lock
-- gets released if there happens to be an exception.
-- In some cases we may be able to convince ourselves that no exception
-- is possible, but there is still the possibility of Storage_Error.
with POSIX.IO,
POSIX.Implementation,
POSIX.Memory_Mapping,
POSIX.Memory_Range_Locking,
POSIX.Permissions,
POSIX.Shared_Memory_Objects,
System,
System.Storage_Elements,
Unchecked_Conversion;
package body POSIX.Generic_Shared_Memory is
use POSIX.Implementation;
use type POSIX.IO.File_Descriptor;
use type POSIX.Memory_Mapping.Protection_Options;
Length : constant POSIX.IO_Count :=
Object_Type'Max_Size_In_Storage_Elements;
type Private_Ptr is access all Object_Type;
function To_Shared_Access is
new Unchecked_Conversion (Private_Ptr, Shared_Access);
-- One instantiation of this package can be used to open
-- several shared memory objects, with different file descriptors.
-- We need a list to keep track of the mapping from file descriptor
-- to start-address.
type Node;
type Node_List is access all Node;
type Node is record
FD : POSIX.IO.File_Descriptor;
Start_addr : System.Address;
Pointer : Private_Ptr;
Next : Node_List;
end record;
Head : Node_List := null;
pragma Volatile (Head);
Avail : Node_List := null;
pragma Volatile (Avail);
------------------------
-- Local Subprograms --
------------------------
procedure Insert_Node
(FD : POSIX.IO.File_Descriptor;
Start : System.Address);
function Start_Of_Shared_Memory
(File : POSIX.IO.File_Descriptor) return System.Address;
procedure Remove_Node (FD : POSIX.IO.File_Descriptor);
-------------------
-- Insert_Node --
-------------------
procedure Insert_Node
(FD : POSIX.IO.File_Descriptor;
Start : System.Address) is
T : Node_List;
-- The local object is necessary to force initialization.
-- Unfortunately, it means that if the type has finalization
-- we also get the finalization, before we return from this call.
-- .... That is unwanted, but what else can we do?
X : aliased Object_Type;
for X'Address use Start;
begin
if Avail /= null then
T := Avail; Avail := Avail.Next;
else
T := new Node;
end if;
T.FD := FD;
T.Start_addr := Start;
T.Pointer := X'Unchecked_Access;
T.Next := Head;
Head := T;
end Insert_Node;
-------------------
-- Remove_Node --
-------------------
procedure Remove_Node (FD : POSIX.IO.File_Descriptor) is
T, Prev : Node_List;
begin
T := Head;
Prev := Head;
while T /= null loop
if T.FD = FD then
if Prev = T then Head := T.Next;
else Prev.Next := T.Next;
end if;
T.Next := Avail;
Avail := T;
return;
else Prev := T; T := T.Next;
end if;
end loop;
Raise_POSIX_Error (POSIX.Bad_File_Descriptor);
end Remove_Node;
------------------------------
-- Start_Of_Shared_Memory --
------------------------------
function Start_Of_Shared_Memory
(File : POSIX.IO.File_Descriptor) return System.Address is
T : Node_List;
begin
Begin_Critical_Section;
begin
T := Head;
while T /= null loop
if T.FD = File then
End_Critical_Section;
return T.Start_addr;
end if;
T := T.Next;
end loop;
End_Critical_Section;
exception when others =>
End_Critical_Section; raise;
end;
Raise_POSIX_Error (POSIX.Bad_File_Descriptor);
-- to suppress compiler warning:
return System.Null_Address;
end Start_Of_Shared_Memory;
----------------------------------
-- Open_And_Map_Shared_Memory --
----------------------------------
-- No adjustment of signal mask in these procedures.
-- We just pass on the masking information to the "open".
function Open_And_Map_Shared_Memory
(Name : POSIX.POSIX_String;
Protection : POSIX.Memory_Mapping.Protection_Options;
Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals)
return POSIX.IO.File_Descriptor is
FD : POSIX.IO.File_Descriptor;
Mode : POSIX.IO.File_Mode;
begin
if Protection = POSIX.Memory_Mapping.Allow_Write then
Mode := POSIX.IO.Read_Write;
else Mode := POSIX.IO.Read_Only;
end if;
Begin_Critical_Section;
begin
FD := POSIX.Shared_Memory_Objects.Open_Shared_Memory
(Name, Mode, POSIX.IO.Empty_Set, Masked_Signals);
POSIX.IO.Truncate_File (FD, Length);
Insert_Node (FD, POSIX.Memory_Mapping.Map_Memory
(System.Storage_Elements.Storage_Offset (Length),
Protection, POSIX.Memory_Mapping.Map_Shared, FD, 0));
End_Critical_Section;
exception when others =>
End_Critical_Section; raise;
end;
return FD;
end Open_And_Map_Shared_Memory;
--------------------------------------------
-- Open_Or_Create_And_Map_Shared_Memory --
--------------------------------------------
function Open_Or_Create_And_Map_Shared_Memory
(Name : POSIX.POSIX_String;
Protection : POSIX.Memory_Mapping.Protection_Options;
Permissions : POSIX.Permissions.Permission_Set;
Options : POSIX.IO.Open_Option_Set := -- POSIX.IO.Empty_Set;
POSIX.IO.Open_Option_Set (POSIX.IO.Empty_Set);
-- Conversion is only to work around a GNAT3.09 problem.
Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals)
return POSIX.IO.File_Descriptor is
FD : POSIX.IO.File_Descriptor;
Mode : POSIX.IO.File_Mode;
begin
if Protection = POSIX.Memory_Mapping.Allow_Write then
Mode := POSIX.IO.Read_Write;
else Mode := POSIX.IO.Read_Only;
end if;
Begin_Critical_Section;
begin
FD := POSIX.Shared_Memory_Objects.Open_Or_Create_Shared_Memory
(Name, Mode, Permissions, Options, Masked_Signals);
POSIX.IO.Truncate_File (FD, Length);
Insert_Node (FD, POSIX.Memory_Mapping.Map_Memory
(System.Storage_Elements.Storage_Offset (Length),
Protection, POSIX.Memory_Mapping.Map_Shared, FD, 0));
End_Critical_Section;
exception when others =>
End_Critical_Section; raise;
end;
return FD;
end Open_Or_Create_And_Map_Shared_Memory;
----------------------------
-- Access_Shared_Memory --
----------------------------
function Access_Shared_Memory
(File : POSIX.IO.File_Descriptor) return Shared_Access is
T : Node_List;
begin
Begin_Critical_Section;
begin
T := Head;
while T /= null loop
if T.FD = File then
End_Critical_Section;
return To_Shared_Access (T.Pointer);
end if;
T := T.Next;
end loop;
End_Critical_Section;
exception when others =>
End_Critical_Section; raise;
end;
Raise_POSIX_Error (POSIX.Bad_File_Descriptor);
-- To suppress compiler warning message:
return null;
end Access_Shared_Memory;
-------------------------------------
-- Unmap_And_Close_Shared_Memory --
-------------------------------------
procedure Unmap_And_Close_Shared_Memory
(File : in POSIX.IO.File_Descriptor) is
begin
Begin_Critical_Section;
begin
POSIX.Memory_Mapping.Unmap_Memory
(Start_Of_Shared_Memory (File),
Object_Type'Max_Size_In_Storage_Elements);
Remove_Node (File);
POSIX.IO.Close (File);
End_Critical_Section;
exception when others =>
End_Critical_Section; raise;
end;
-- .... If we could detect "last close", and if we could
-- detect that the type has finalization, we might want to
-- call finalization here, for the last close.
end Unmap_And_Close_Shared_Memory;
--------------------------
-- Lock_Shared_Memory --
--------------------------
procedure Lock_Shared_Memory
(File : in POSIX.IO.File_Descriptor) is
begin
POSIX.Memory_Range_Locking.Lock_Range
(Start_Of_Shared_Memory (File),
System.Storage_Elements.Storage_Offset
(Object_Type'Max_Size_In_Storage_Elements));
end Lock_Shared_Memory;
----------------------------
-- Unlock_Shared_Memory --
----------------------------
procedure Unlock_Shared_Memory
(File : in POSIX.IO.File_Descriptor) is
begin
POSIX.Memory_Range_Locking.Unlock_Range
(Start_Of_Shared_Memory (File),
System.Storage_Elements.Storage_Offset
(Object_Type'Max_Size_In_Storage_Elements));
end Unlock_Shared_Memory;
end POSIX.Generic_Shared_Memory;