blob: 3c526e8386081300a139f067ad25b42725d59819 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . M M A P --
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2022, AdaCore --
-- --
-- This library 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 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.IO_Exceptions;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with System.Strings; use System.Strings;
with System.Mmap.OS_Interface; use System.Mmap.OS_Interface;
package body System.Mmap is
type Mapped_File_Record is record
Current_Region : Mapped_Region;
-- The legacy API enables only one region to be mapped, directly
-- associated with the mapped file. This references this region.
File : System_File;
-- Underlying OS-level file
end record;
type Mapped_Region_Record is record
File : Mapped_File;
-- The file this region comes from. Be careful: for reading file, it is
-- valid to have it closed before one of its regions is free'd.
Write : Boolean;
-- Whether the file this region comes from is open for writing.
Data : Str_Access;
-- Unbounded access to the mapped content.
System_Offset : File_Size;
-- Position in the file of the first byte actually mapped in memory
User_Offset : File_Size;
-- Position in the file of the first byte requested by the user
System_Size : File_Size;
-- Size of the region actually mapped in memory
User_Size : File_Size;
-- Size of the region requested by the user
Mapped : Boolean;
-- Whether this region is actually memory mapped
Mutable : Boolean;
-- If the file is opened for reading, wheter this region is writable
Buffer : System.Strings.String_Access;
-- When this region is not actually memory mapped, contains the
-- requested bytes.
Mapping : System_Mapping;
-- Underlying OS-level data for the mapping, if any
end record;
Invalid_Mapped_Region_Record : constant Mapped_Region_Record :=
(null, False, null, 0, 0, 0, 0, False, False, null,
Invalid_System_Mapping);
Invalid_Mapped_File_Record : constant Mapped_File_Record :=
(Invalid_Mapped_Region, Invalid_System_File);
Empty_String : constant String := "";
-- Used to provide a valid empty Data for empty files, for instanc.
procedure Dispose is new Ada.Unchecked_Deallocation
(Mapped_File_Record, Mapped_File);
procedure Dispose is new Ada.Unchecked_Deallocation
(Mapped_Region_Record, Mapped_Region);
function Convert is new Ada.Unchecked_Conversion
(Standard.System.Address, Str_Access);
procedure Compute_Data (Region : Mapped_Region);
-- Fill the Data field according to system and user offsets. The region
-- must actually be mapped or bufferized.
procedure From_Disk (Region : Mapped_Region);
-- Read a region of some file from the disk
procedure To_Disk (Region : Mapped_Region);
-- Write the region of the file back to disk if necessary, and free memory
----------------------------
-- Open_Read_No_Exception --
----------------------------
function Open_Read_No_Exception
(Filename : String;
Use_Mmap_If_Available : Boolean := True) return Mapped_File
is
File : constant System_File :=
Open_Read (Filename, Use_Mmap_If_Available);
begin
if File = Invalid_System_File then
return Invalid_Mapped_File;
end if;
return new Mapped_File_Record'
(Current_Region => Invalid_Mapped_Region,
File => File);
end Open_Read_No_Exception;
---------------
-- Open_Read --
---------------
function Open_Read
(Filename : String;
Use_Mmap_If_Available : Boolean := True) return Mapped_File
is
Res : constant Mapped_File :=
Open_Read_No_Exception (Filename, Use_Mmap_If_Available);
begin
if Res = Invalid_Mapped_File then
raise Ada.IO_Exceptions.Name_Error
with "Cannot open " & Filename;
else
return Res;
end if;
end Open_Read;
----------------
-- Open_Write --
----------------
function Open_Write
(Filename : String;
Use_Mmap_If_Available : Boolean := True) return Mapped_File
is
File : constant System_File :=
Open_Write (Filename, Use_Mmap_If_Available);
begin
if File = Invalid_System_File then
raise Ada.IO_Exceptions.Name_Error
with "Cannot open " & Filename;
else
return new Mapped_File_Record'
(Current_Region => Invalid_Mapped_Region,
File => File);
end if;
end Open_Write;
-----------
-- Close --
-----------
procedure Close (File : in out Mapped_File) is
begin
-- Closing a closed file is allowed and should do nothing
if File = Invalid_Mapped_File then
return;
end if;
if File.Current_Region /= null then
Free (File.Current_Region);
end if;
if File.File /= Invalid_System_File then
Close (File.File);
end if;
Dispose (File);
end Close;
----------
-- Free --
----------
procedure Free (Region : in out Mapped_Region) is
Ignored : Integer;
pragma Unreferenced (Ignored);
begin
-- Freeing an already free'd file is allowed and should do nothing
if Region = Invalid_Mapped_Region then
return;
end if;
if Region.Mapping /= Invalid_System_Mapping then
Dispose_Mapping (Region.Mapping);
end if;
To_Disk (Region);
Dispose (Region);
end Free;
----------
-- Read --
----------
procedure Read
(File : Mapped_File;
Region : in out Mapped_Region;
Offset : File_Size := 0;
Length : File_Size := 0;
Mutable : Boolean := False)
is
File_Length : constant File_Size := Mmap.Length (File);
Req_Offset : constant File_Size := Offset;
Req_Length : File_Size := Length;
-- Offset and Length of the region to map, used to adjust mapping
-- bounds, reflecting what the user will see.
Region_Allocated : Boolean := False;
begin
-- If this region comes from another file, or simply if the file is
-- writeable, we cannot re-use this mapping: free it first.
if Region /= Invalid_Mapped_Region
and then
(Region.File /= File or else File.File.Write)
then
Free (Region);
end if;
if Region = Invalid_Mapped_Region then
Region := new Mapped_Region_Record'(Invalid_Mapped_Region_Record);
Region_Allocated := True;
end if;
Region.File := File;
if Req_Offset >= File_Length then
-- If the requested offset goes beyond file size, map nothing
Req_Length := 0;
elsif Length = 0
or else
Length > File_Length - Req_Offset
then
-- If Length is 0 or goes beyond file size, map till end of file
Req_Length := File_Length - Req_Offset;
else
Req_Length := Length;
end if;
-- Past this point, the offset/length the user will see is fixed. On the
-- other hand, the system offset/length is either already defined, from
-- a previous mapping, or it is set to 0. In the latter case, the next
-- step will set them according to the mapping.
Region.User_Offset := Req_Offset;
Region.User_Size := Req_Length;
-- If the requested region is inside an already mapped region, adjust
-- user-requested data and do nothing else.
if (File.File.Write or else Region.Mutable = Mutable)
and then
Req_Offset >= Region.System_Offset
and then
(Req_Offset + Req_Length
<= Region.System_Offset + Region.System_Size)
then
Region.User_Offset := Req_Offset;
Compute_Data (Region);
return;
elsif Region.Buffer /= null then
-- Otherwise, as we are not going to re-use the buffer, free it
System.Strings.Free (Region.Buffer);
Region.Buffer := null;
elsif Region.Mapping /= Invalid_System_Mapping then
-- Otherwise, there is a memory mapping that we need to unmap.
Dispose_Mapping (Region.Mapping);
end if;
-- mmap() will sometimes return NULL when the file exists but is empty,
-- which is not what we want, so in the case of a zero length file we
-- fall back to read(2)/write(2)-based mode.
if File_Length > 0 and then File.File.Mapped then
Region.System_Offset := Req_Offset;
Region.System_Size := Req_Length;
Create_Mapping
(File.File,
Region.System_Offset, Region.System_Size,
Mutable,
Region.Mapping);
Region.Mapped := True;
Region.Mutable := Mutable;
else
-- There is no alignment requirement when manually reading the file.
Region.System_Offset := Req_Offset;
Region.System_Size := Req_Length;
Region.Mapped := False;
Region.Mutable := True;
From_Disk (Region);
end if;
Region.Write := File.File.Write;
Compute_Data (Region);
exception
when others =>
-- Before propagating any exception, free any region we allocated
-- here.
if Region_Allocated then
Dispose (Region);
end if;
raise;
end Read;
----------
-- Read --
----------
procedure Read
(File : Mapped_File;
Offset : File_Size := 0;
Length : File_Size := 0;
Mutable : Boolean := False)
is
begin
Read (File, File.Current_Region, Offset, Length, Mutable);
end Read;
----------
-- Read --
----------
function Read
(File : Mapped_File;
Offset : File_Size := 0;
Length : File_Size := 0;
Mutable : Boolean := False) return Mapped_Region
is
Region : Mapped_Region := Invalid_Mapped_Region;
begin
Read (File, Region, Offset, Length, Mutable);
return Region;
end Read;
------------
-- Length --
------------
function Length (File : Mapped_File) return File_Size is
begin
return File.File.Length;
end Length;
------------
-- Offset --
------------
function Offset (Region : Mapped_Region) return File_Size is
begin
return Region.User_Offset;
end Offset;
------------
-- Offset --
------------
function Offset (File : Mapped_File) return File_Size is
begin
return Offset (File.Current_Region);
end Offset;
----------
-- Last --
----------
function Last (Region : Mapped_Region) return Integer is
begin
return Integer (Region.User_Size);
end Last;
----------
-- Last --
----------
function Last (File : Mapped_File) return Integer is
begin
return Last (File.Current_Region);
end Last;
-------------------
-- To_Str_Access --
-------------------
function To_Str_Access
(Str : System.Strings.String_Access) return Str_Access is
begin
if Str = null then
return null;
else
return Convert (Str.all'Address);
end if;
end To_Str_Access;
----------
-- Data --
----------
function Data (Region : Mapped_Region) return Str_Access is
begin
return Region.Data;
end Data;
----------
-- Data --
----------
function Data (File : Mapped_File) return Str_Access is
begin
return Data (File.Current_Region);
end Data;
----------------
-- Is_Mutable --
----------------
function Is_Mutable (Region : Mapped_Region) return Boolean is
begin
return Region.Mutable or Region.Write;
end Is_Mutable;
----------------
-- Is_Mmapped --
----------------
function Is_Mmapped (File : Mapped_File) return Boolean is
begin
return File.File.Mapped;
end Is_Mmapped;
-------------------
-- Get_Page_Size --
-------------------
function Get_Page_Size return Integer is
Result : constant File_Size := Get_Page_Size;
begin
return Integer (Result);
end Get_Page_Size;
---------------------
-- Read_Whole_File --
---------------------
function Read_Whole_File
(Filename : String;
Empty_If_Not_Found : Boolean := False)
return System.Strings.String_Access
is
File : Mapped_File := Open_Read (Filename);
Region : Mapped_Region renames File.Current_Region;
Result : String_Access;
begin
Read (File);
if Region.Data /= null then
Result := new String'(String
(Region.Data (1 .. Last (Region))));
elsif Region.Buffer /= null then
Result := Region.Buffer;
Region.Buffer := null; -- So that it is not deallocated
end if;
Close (File);
return Result;
exception
when Ada.IO_Exceptions.Name_Error =>
if Empty_If_Not_Found then
return new String'("");
else
return null;
end if;
when others =>
Close (File);
return null;
end Read_Whole_File;
---------------
-- From_Disk --
---------------
procedure From_Disk (Region : Mapped_Region) is
begin
pragma Assert (Region.File.all /= Invalid_Mapped_File_Record);
pragma Assert (Region.Buffer = null);
Region.Buffer := Read_From_Disk
(Region.File.File, Region.User_Offset, Region.User_Size);
Region.Mapped := False;
end From_Disk;
-------------
-- To_Disk --
-------------
procedure To_Disk (Region : Mapped_Region) is
begin
if Region.Write and then Region.Buffer /= null then
pragma Assert (Region.File.all /= Invalid_Mapped_File_Record);
Write_To_Disk
(Region.File.File,
Region.User_Offset, Region.User_Size,
Region.Buffer);
end if;
System.Strings.Free (Region.Buffer);
Region.Buffer := null;
end To_Disk;
------------------
-- Compute_Data --
------------------
procedure Compute_Data (Region : Mapped_Region) is
Base_Data : Str_Access;
-- Address of the first byte actually mapped in memory
Data_Shift : constant Integer :=
Integer (Region.User_Offset - Region.System_Offset);
begin
if Region.User_Size = 0 then
Region.Data := Convert (Empty_String'Address);
return;
elsif Region.Mapped then
Base_Data := Convert (Region.Mapping.Address);
else
Base_Data := Convert (Region.Buffer.all'Address);
end if;
Region.Data := Convert (Base_Data (Data_Shift + 1)'Address);
end Compute_Data;
end System.Mmap;