------------------------------------------------------------------------------ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- -- S Y S T E M . M M A P -- -- -- -- B o d y -- -- -- -- Copyright (C) 2007-2024, 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 -- -- . -- -- -- -- 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, whether 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;