------------------------------------------------------------------------------ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- -- S Y S T E M . M M A P . O S _ I N T E R F A C E -- -- -- -- 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 -- -- . -- -- -- -- 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 System; use System; with System.OS_Lib; use System.OS_Lib; with System.Mmap.Unix; use System.Mmap.Unix; package body System.Mmap.OS_Interface is function Align (Addr : File_Size) return File_Size; -- Align some offset/length to the lowest page boundary function Is_Mapping_Available return Boolean renames System.Mmap.Unix.Is_Mapping_Available; -- Wheter memory mapping is actually available on this system. It is an -- error to use Create_Mapping and Dispose_Mapping if this is False. --------------- -- Open_Read -- --------------- function Open_Read (Filename : String; Use_Mmap_If_Available : Boolean := True) return System_File is Fd : constant File_Descriptor := Open_Read (Filename, Binary); begin if Fd = Invalid_FD then return Invalid_System_File; end if; return (Fd => Fd, Mapped => Use_Mmap_If_Available and then Is_Mapping_Available, Write => False, Length => File_Size (File_Length (Fd))); end Open_Read; ---------------- -- Open_Write -- ---------------- function Open_Write (Filename : String; Use_Mmap_If_Available : Boolean := True) return System_File is Fd : constant File_Descriptor := Open_Read_Write (Filename, Binary); begin if Fd = Invalid_FD then return Invalid_System_File; end if; return (Fd => Fd, Mapped => Use_Mmap_If_Available and then Is_Mapping_Available, Write => True, Length => File_Size (File_Length (Fd))); end Open_Write; ----------- -- Close -- ----------- procedure Close (File : in out System_File) is begin Close (File.Fd); File.Fd := Invalid_FD; end Close; -------------------- -- Read_From_Disk -- -------------------- function Read_From_Disk (File : System_File; Offset, Length : File_Size) return System.Strings.String_Access is Buffer : String_Access := new String (1 .. Integer (Length)); begin -- ??? Lseek offset should be a size_t instead of a Long_Integer Lseek (File.Fd, Long_Integer (Offset), Seek_Set); if System.OS_Lib.Read (File.Fd, Buffer.all'Address, Integer (Length)) /= Integer (Length) then System.Strings.Free (Buffer); raise Ada.IO_Exceptions.Device_Error; end if; return Buffer; end Read_From_Disk; ------------------- -- Write_To_Disk -- ------------------- procedure Write_To_Disk (File : System_File; Offset, Length : File_Size; Buffer : System.Strings.String_Access) is begin pragma Assert (File.Write); Lseek (File.Fd, Long_Integer (Offset), Seek_Set); if System.OS_Lib.Write (File.Fd, Buffer.all'Address, Integer (Length)) /= Integer (Length) then raise Ada.IO_Exceptions.Device_Error; end if; end Write_To_Disk; -------------------- -- Create_Mapping -- -------------------- procedure Create_Mapping (File : System_File; Offset, Length : in out File_Size; Mutable : Boolean; Mapping : out System_Mapping) is Prot : Mmap_Prot; Flags : Mmap_Flags; begin if File.Write then Prot := PROT_READ + PROT_WRITE; Flags := MAP_SHARED; else Prot := PROT_READ; if Mutable then Prot := Prot + PROT_WRITE; end if; Flags := MAP_PRIVATE; end if; -- Adjust offset and mapping length to account for the required -- alignment of offset on page boundary. declare Queried_Offset : constant File_Size := Offset; begin Offset := Align (Offset); -- First extend the length to compensate the offset shift, then align -- it on the upper page boundary, so that the whole queried area is -- covered. Length := Length + Queried_Offset - Offset; Length := Align (Length + Get_Page_Size - 1); end; if Length > File_Size (Integer'Last) then raise Ada.IO_Exceptions.Device_Error; else Mapping := (Address => System.Mmap.Unix.Mmap (Offset => off_t (Offset), Length => Interfaces.C.size_t (Length), Prot => Prot, Flags => Flags, Fd => File.Fd), Length => Length); end if; end Create_Mapping; --------------------- -- Dispose_Mapping -- --------------------- procedure Dispose_Mapping (Mapping : in out System_Mapping) is Ignored : Integer; pragma Unreferenced (Ignored); begin Ignored := Munmap (Mapping.Address, Interfaces.C.size_t (Mapping.Length)); Mapping := Invalid_System_Mapping; end Dispose_Mapping; ------------------- -- Get_Page_Size -- ------------------- function Get_Page_Size return File_Size is function Internal return Integer; pragma Import (C, Internal, "getpagesize"); begin return File_Size (Internal); end Get_Page_Size; ----------- -- Align -- ----------- function Align (Addr : File_Size) return File_Size is begin return Addr - Addr mod Get_Page_Size; end Align; end System.Mmap.OS_Interface;