1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- S Y S T E M . M M A P . O S _ I N T E R F A C E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2007-2018, AdaCore -- 10-- -- 11-- This library is free software; you can redistribute it and/or modify it -- 12-- under terms of the GNU General Public License as published by the Free -- 13-- Software Foundation; either version 3, or (at your option) any later -- 14-- version. This library is distributed in the hope that it will be useful, -- 15-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 16-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with Ada.IO_Exceptions; 33with System; use System; 34 35with System.OS_Lib; use System.OS_Lib; 36with System.Mmap.Unix; use System.Mmap.Unix; 37 38package body System.Mmap.OS_Interface is 39 40 function Align 41 (Addr : File_Size) return File_Size; 42 -- Align some offset/length to the lowest page boundary 43 44 function Is_Mapping_Available return Boolean renames 45 System.Mmap.Unix.Is_Mapping_Available; 46 -- Wheter memory mapping is actually available on this system. It is an 47 -- error to use Create_Mapping and Dispose_Mapping if this is False. 48 49 --------------- 50 -- Open_Read -- 51 --------------- 52 53 function Open_Read 54 (Filename : String; 55 Use_Mmap_If_Available : Boolean := True) return System_File is 56 Fd : constant File_Descriptor := 57 Open_Read (Filename, Binary); 58 begin 59 if Fd = Invalid_FD then 60 return Invalid_System_File; 61 end if; 62 return 63 (Fd => Fd, 64 Mapped => Use_Mmap_If_Available and then Is_Mapping_Available, 65 Write => False, 66 Length => File_Size (File_Length (Fd))); 67 end Open_Read; 68 69 ---------------- 70 -- Open_Write -- 71 ---------------- 72 73 function Open_Write 74 (Filename : String; 75 Use_Mmap_If_Available : Boolean := True) return System_File is 76 Fd : constant File_Descriptor := 77 Open_Read_Write (Filename, Binary); 78 begin 79 if Fd = Invalid_FD then 80 return Invalid_System_File; 81 end if; 82 return 83 (Fd => Fd, 84 Mapped => Use_Mmap_If_Available and then Is_Mapping_Available, 85 Write => True, 86 Length => File_Size (File_Length (Fd))); 87 end Open_Write; 88 89 ----------- 90 -- Close -- 91 ----------- 92 93 procedure Close (File : in out System_File) is 94 begin 95 Close (File.Fd); 96 File.Fd := Invalid_FD; 97 end Close; 98 99 -------------------- 100 -- Read_From_Disk -- 101 -------------------- 102 103 function Read_From_Disk 104 (File : System_File; 105 Offset, Length : File_Size) return System.Strings.String_Access 106 is 107 Buffer : String_Access := new String (1 .. Integer (Length)); 108 begin 109 -- ??? Lseek offset should be a size_t instead of a Long_Integer 110 111 Lseek (File.Fd, Long_Integer (Offset), Seek_Set); 112 if System.OS_Lib.Read (File.Fd, Buffer.all'Address, Integer (Length)) 113 /= Integer (Length) 114 then 115 System.Strings.Free (Buffer); 116 raise Ada.IO_Exceptions.Device_Error; 117 end if; 118 return Buffer; 119 end Read_From_Disk; 120 121 ------------------- 122 -- Write_To_Disk -- 123 ------------------- 124 125 procedure Write_To_Disk 126 (File : System_File; 127 Offset, Length : File_Size; 128 Buffer : System.Strings.String_Access) is 129 begin 130 pragma Assert (File.Write); 131 Lseek (File.Fd, Long_Integer (Offset), Seek_Set); 132 if System.OS_Lib.Write (File.Fd, Buffer.all'Address, Integer (Length)) 133 /= Integer (Length) 134 then 135 raise Ada.IO_Exceptions.Device_Error; 136 end if; 137 end Write_To_Disk; 138 139 -------------------- 140 -- Create_Mapping -- 141 -------------------- 142 143 procedure Create_Mapping 144 (File : System_File; 145 Offset, Length : in out File_Size; 146 Mutable : Boolean; 147 Mapping : out System_Mapping) 148 is 149 Prot : Mmap_Prot; 150 Flags : Mmap_Flags; 151 begin 152 if File.Write then 153 Prot := PROT_READ + PROT_WRITE; 154 Flags := MAP_SHARED; 155 else 156 Prot := PROT_READ; 157 if Mutable then 158 Prot := Prot + PROT_WRITE; 159 end if; 160 Flags := MAP_PRIVATE; 161 end if; 162 163 -- Adjust offset and mapping length to account for the required 164 -- alignment of offset on page boundary. 165 166 declare 167 Queried_Offset : constant File_Size := Offset; 168 begin 169 Offset := Align (Offset); 170 171 -- First extend the length to compensate the offset shift, then align 172 -- it on the upper page boundary, so that the whole queried area is 173 -- covered. 174 175 Length := Length + Queried_Offset - Offset; 176 Length := Align (Length + Get_Page_Size - 1); 177 end; 178 179 if Length > File_Size (Integer'Last) then 180 raise Ada.IO_Exceptions.Device_Error; 181 else 182 Mapping := 183 (Address => System.Mmap.Unix.Mmap 184 (Offset => off_t (Offset), 185 Length => Interfaces.C.size_t (Length), 186 Prot => Prot, 187 Flags => Flags, 188 Fd => File.Fd), 189 Length => Length); 190 end if; 191 end Create_Mapping; 192 193 --------------------- 194 -- Dispose_Mapping -- 195 --------------------- 196 197 procedure Dispose_Mapping 198 (Mapping : in out System_Mapping) 199 is 200 Ignored : Integer; 201 pragma Unreferenced (Ignored); 202 begin 203 Ignored := Munmap 204 (Mapping.Address, Interfaces.C.size_t (Mapping.Length)); 205 Mapping := Invalid_System_Mapping; 206 end Dispose_Mapping; 207 208 ------------------- 209 -- Get_Page_Size -- 210 ------------------- 211 212 function Get_Page_Size return File_Size is 213 function Internal return Integer; 214 pragma Import (C, Internal, "getpagesize"); 215 begin 216 return File_Size (Internal); 217 end Get_Page_Size; 218 219 ----------- 220 -- Align -- 221 ----------- 222 223 function Align 224 (Addr : File_Size) return File_Size is 225 begin 226 return Addr - Addr mod Get_Page_Size; 227 end Align; 228 229end System.Mmap.OS_Interface; 230