| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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; |
