diff options
Diffstat (limited to 'gcc/ada/s-mmap.adb')
| -rw-r--r-- | gcc/ada/s-mmap.adb | 548 |
1 files changed, 548 insertions, 0 deletions
diff --git a/gcc/ada/s-mmap.adb b/gcc/ada/s-mmap.adb new file mode 100644 index 0000000..e9b2aff --- /dev/null +++ b/gcc/ada/s-mmap.adb @@ -0,0 +1,548 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . M M A P -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2007-2016, 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 -- + --------------- + + function Open_Read + (Filename : String; + Use_Mmap_If_Available : Boolean := True) return Mapped_File + is + File : constant System_File := + Open_Read (Filename, Use_Mmap_If_Available); + begin + return new Mapped_File_Record' + (Current_Region => Invalid_Mapped_Region, + File => File); + 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 + return new Mapped_File_Record' + (Current_Region => Invalid_Mapped_Region, + File => File); + 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; |