|
111
|
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 -- --
|
|
131
|
9 -- Copyright (C) 2007-2018, AdaCore --
|
|
111
|
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
|
|
|
32 with Ada.IO_Exceptions;
|
|
|
33 with System.Strings; use System.Strings;
|
|
|
34
|
|
|
35 with System.OS_Lib;
|
|
|
36 pragma Unreferenced (System.OS_Lib);
|
|
|
37 -- Only used to generate same runtime dependencies and same binder file on
|
|
|
38 -- GNU/Linux and Windows.
|
|
|
39
|
|
|
40 package body System.Mmap.OS_Interface is
|
|
|
41
|
|
|
42 use Win;
|
|
|
43
|
|
|
44 function Align
|
|
|
45 (Addr : File_Size) return File_Size;
|
|
|
46 -- Align some offset/length to the lowest page boundary
|
|
|
47
|
|
|
48 function Open_Common
|
|
|
49 (Filename : String;
|
|
|
50 Use_Mmap_If_Available : Boolean;
|
|
|
51 Write : Boolean) return System_File;
|
|
|
52
|
|
|
53 function From_UTF8 (Path : String) return Wide_String;
|
|
|
54 -- Convert from UTF-8 to Wide_String
|
|
|
55
|
|
|
56 ---------------
|
|
|
57 -- From_UTF8 --
|
|
|
58 ---------------
|
|
|
59
|
|
|
60 function From_UTF8 (Path : String) return Wide_String is
|
|
|
61 function MultiByteToWideChar
|
|
|
62 (Codepage : Interfaces.C.unsigned;
|
|
|
63 Flags : Interfaces.C.unsigned;
|
|
|
64 Mbstr : Address;
|
|
|
65 Mb : Natural;
|
|
|
66 Wcstr : Address;
|
|
|
67 Wc : Natural) return Integer;
|
|
|
68 pragma Import (Stdcall, MultiByteToWideChar, "MultiByteToWideChar");
|
|
|
69
|
|
|
70 Current_Codepage : Interfaces.C.unsigned;
|
|
|
71 pragma Import (C, Current_Codepage, "__gnat_current_codepage");
|
|
|
72
|
|
|
73 Len : Natural;
|
|
|
74 begin
|
|
|
75 -- Compute length of the result
|
|
|
76 Len := MultiByteToWideChar
|
|
|
77 (Current_Codepage, 0, Path'Address, Path'Length, Null_Address, 0);
|
|
|
78 if Len = 0 then
|
|
|
79 raise Constraint_Error;
|
|
|
80 end if;
|
|
|
81
|
|
|
82 declare
|
|
|
83 -- Declare result
|
|
|
84 Res : Wide_String (1 .. Len);
|
|
|
85 begin
|
|
|
86 -- And compute it
|
|
|
87 Len := MultiByteToWideChar
|
|
|
88 (Current_Codepage, 0,
|
|
|
89 Path'Address, Path'Length,
|
|
|
90 Res'Address, Len);
|
|
|
91 if Len = 0 then
|
|
|
92 raise Constraint_Error;
|
|
|
93 end if;
|
|
|
94 return Res;
|
|
|
95 end;
|
|
|
96 end From_UTF8;
|
|
|
97
|
|
|
98 -----------------
|
|
|
99 -- Open_Common --
|
|
|
100 -----------------
|
|
|
101
|
|
|
102 function Open_Common
|
|
|
103 (Filename : String;
|
|
|
104 Use_Mmap_If_Available : Boolean;
|
|
|
105 Write : Boolean) return System_File
|
|
|
106 is
|
|
|
107 dwDesiredAccess, dwShareMode : DWORD;
|
|
|
108 PageFlags : DWORD;
|
|
|
109
|
|
|
110 W_Filename : constant Wide_String :=
|
|
|
111 From_UTF8 (Filename) & Wide_Character'Val (0);
|
|
|
112 File_Handle, Mapping_Handle : HANDLE;
|
|
|
113
|
|
|
114 SizeH : aliased DWORD;
|
|
|
115 Size : File_Size;
|
|
|
116 begin
|
|
|
117 if Write then
|
|
|
118 dwDesiredAccess := GENERIC_READ + GENERIC_WRITE;
|
|
|
119 dwShareMode := 0;
|
|
|
120 PageFlags := Win.PAGE_READWRITE;
|
|
|
121 else
|
|
|
122 dwDesiredAccess := GENERIC_READ;
|
|
|
123 dwShareMode := Win.FILE_SHARE_READ;
|
|
|
124 PageFlags := Win.PAGE_READONLY;
|
|
|
125 end if;
|
|
|
126
|
|
|
127 -- Actually open the file
|
|
|
128
|
|
|
129 File_Handle := CreateFile
|
|
|
130 (W_Filename'Address, dwDesiredAccess, dwShareMode,
|
|
|
131 null, OPEN_EXISTING, Win.FILE_ATTRIBUTE_NORMAL, 0);
|
|
|
132
|
|
|
133 if File_Handle = Win.INVALID_HANDLE_VALUE then
|
|
|
134 return Invalid_System_File;
|
|
|
135 end if;
|
|
|
136
|
|
|
137 -- Compute its size
|
|
|
138
|
|
|
139 Size := File_Size (Win.GetFileSize (File_Handle, SizeH'Access));
|
|
|
140
|
|
|
141 if Size = Win.INVALID_FILE_SIZE then
|
|
|
142 return Invalid_System_File;
|
|
|
143 end if;
|
|
|
144
|
|
|
145 if SizeH /= 0 and then File_Size'Size > 32 then
|
|
|
146 Size := Size + (File_Size (SizeH) * 2 ** 32);
|
|
|
147 end if;
|
|
|
148
|
|
|
149 -- Then create a mapping object, if needed. On Win32, file memory
|
|
|
150 -- mapping is always available.
|
|
|
151
|
|
|
152 if Use_Mmap_If_Available then
|
|
|
153 Mapping_Handle :=
|
|
|
154 Win.CreateFileMapping
|
|
|
155 (File_Handle, null, PageFlags,
|
|
|
156 0, DWORD (Size), Standard.System.Null_Address);
|
|
|
157 else
|
|
|
158 Mapping_Handle := Win.INVALID_HANDLE_VALUE;
|
|
|
159 end if;
|
|
|
160
|
|
|
161 return
|
|
|
162 (Handle => File_Handle,
|
|
|
163 Mapped => Use_Mmap_If_Available,
|
|
|
164 Mapping_Handle => Mapping_Handle,
|
|
|
165 Write => Write,
|
|
|
166 Length => Size);
|
|
|
167 end Open_Common;
|
|
|
168
|
|
|
169 ---------------
|
|
|
170 -- Open_Read --
|
|
|
171 ---------------
|
|
|
172
|
|
|
173 function Open_Read
|
|
|
174 (Filename : String;
|
|
|
175 Use_Mmap_If_Available : Boolean := True) return System_File is
|
|
|
176 begin
|
|
|
177 return Open_Common (Filename, Use_Mmap_If_Available, False);
|
|
|
178 end Open_Read;
|
|
|
179
|
|
|
180 ----------------
|
|
|
181 -- Open_Write --
|
|
|
182 ----------------
|
|
|
183
|
|
|
184 function Open_Write
|
|
|
185 (Filename : String;
|
|
|
186 Use_Mmap_If_Available : Boolean := True) return System_File is
|
|
|
187 begin
|
|
|
188 return Open_Common (Filename, Use_Mmap_If_Available, True);
|
|
|
189 end Open_Write;
|
|
|
190
|
|
|
191 -----------
|
|
|
192 -- Close --
|
|
|
193 -----------
|
|
|
194
|
|
|
195 procedure Close (File : in out System_File) is
|
|
|
196 Ignored : BOOL;
|
|
|
197 pragma Unreferenced (Ignored);
|
|
|
198 begin
|
|
|
199 Ignored := CloseHandle (File.Mapping_Handle);
|
|
|
200 Ignored := CloseHandle (File.Handle);
|
|
|
201 File.Handle := Win.INVALID_HANDLE_VALUE;
|
|
|
202 File.Mapping_Handle := Win.INVALID_HANDLE_VALUE;
|
|
|
203 end Close;
|
|
|
204
|
|
|
205 --------------------
|
|
|
206 -- Read_From_Disk --
|
|
|
207 --------------------
|
|
|
208
|
|
|
209 function Read_From_Disk
|
|
|
210 (File : System_File;
|
|
|
211 Offset, Length : File_Size) return System.Strings.String_Access
|
|
|
212 is
|
|
|
213 Buffer : String_Access := new String (1 .. Integer (Length));
|
|
|
214
|
|
|
215 Pos : DWORD;
|
|
|
216 NbRead : aliased DWORD;
|
|
|
217 pragma Unreferenced (Pos);
|
|
|
218 begin
|
|
|
219 Pos := Win.SetFilePointer
|
|
|
220 (File.Handle, LONG (Offset), null, Win.FILE_BEGIN);
|
|
|
221
|
|
|
222 if Win.ReadFile
|
|
|
223 (File.Handle, Buffer.all'Address,
|
|
|
224 DWORD (Length), NbRead'Unchecked_Access, null) = Win.FALSE
|
|
|
225 then
|
|
|
226 System.Strings.Free (Buffer);
|
|
|
227 raise Ada.IO_Exceptions.Device_Error;
|
|
|
228 end if;
|
|
|
229 return Buffer;
|
|
|
230 end Read_From_Disk;
|
|
|
231
|
|
|
232 -------------------
|
|
|
233 -- Write_To_Disk --
|
|
|
234 -------------------
|
|
|
235
|
|
|
236 procedure Write_To_Disk
|
|
|
237 (File : System_File;
|
|
|
238 Offset, Length : File_Size;
|
|
|
239 Buffer : System.Strings.String_Access)
|
|
|
240 is
|
|
|
241 Pos : DWORD;
|
|
|
242 NbWritten : aliased DWORD;
|
|
|
243 pragma Unreferenced (Pos);
|
|
|
244 begin
|
|
|
245 pragma Assert (File.Write);
|
|
|
246 Pos := Win.SetFilePointer
|
|
|
247 (File.Handle, LONG (Offset), null, Win.FILE_BEGIN);
|
|
|
248
|
|
|
249 if Win.WriteFile
|
|
|
250 (File.Handle, Buffer.all'Address,
|
|
|
251 DWORD (Length), NbWritten'Unchecked_Access, null) = Win.FALSE
|
|
|
252 then
|
|
|
253 raise Ada.IO_Exceptions.Device_Error;
|
|
|
254 end if;
|
|
|
255 end Write_To_Disk;
|
|
|
256
|
|
|
257 --------------------
|
|
|
258 -- Create_Mapping --
|
|
|
259 --------------------
|
|
|
260
|
|
|
261 procedure Create_Mapping
|
|
|
262 (File : System_File;
|
|
|
263 Offset, Length : in out File_Size;
|
|
|
264 Mutable : Boolean;
|
|
|
265 Mapping : out System_Mapping)
|
|
|
266 is
|
|
|
267 Flags : DWORD;
|
|
|
268 begin
|
|
|
269 if File.Write then
|
|
|
270 Flags := Win.FILE_MAP_WRITE;
|
|
|
271 elsif Mutable then
|
|
|
272 Flags := Win.FILE_MAP_COPY;
|
|
|
273 else
|
|
|
274 Flags := Win.FILE_MAP_READ;
|
|
|
275 end if;
|
|
|
276
|
|
|
277 -- Adjust offset and mapping length to account for the required
|
|
|
278 -- alignment of offset on page boundary.
|
|
|
279
|
|
|
280 declare
|
|
|
281 Queried_Offset : constant File_Size := Offset;
|
|
|
282 begin
|
|
|
283 Offset := Align (Offset);
|
|
|
284
|
|
|
285 -- First extend the length to compensate the offset shift, then align
|
|
|
286 -- it on the upper page boundary, so that the whole queried area is
|
|
|
287 -- covered.
|
|
|
288
|
|
|
289 Length := Length + Queried_Offset - Offset;
|
|
|
290 Length := Align (Length + Get_Page_Size - 1);
|
|
|
291
|
|
|
292 -- But do not exceed the length of the file
|
|
|
293 if Offset + Length > File.Length then
|
|
|
294 Length := File.Length - Offset;
|
|
|
295 end if;
|
|
|
296 end;
|
|
|
297
|
|
|
298 if Length > File_Size (Integer'Last) then
|
|
|
299 raise Ada.IO_Exceptions.Device_Error;
|
|
|
300 else
|
|
|
301 Mapping := Invalid_System_Mapping;
|
|
|
302 Mapping.Address :=
|
|
|
303 Win.MapViewOfFile
|
|
|
304 (File.Mapping_Handle, Flags,
|
|
|
305 0, DWORD (Offset), SIZE_T (Length));
|
|
|
306 Mapping.Length := Length;
|
|
|
307 end if;
|
|
|
308 end Create_Mapping;
|
|
|
309
|
|
|
310 ---------------------
|
|
|
311 -- Dispose_Mapping --
|
|
|
312 ---------------------
|
|
|
313
|
|
|
314 procedure Dispose_Mapping
|
|
|
315 (Mapping : in out System_Mapping)
|
|
|
316 is
|
|
|
317 Ignored : BOOL;
|
|
|
318 pragma Unreferenced (Ignored);
|
|
|
319 begin
|
|
|
320 Ignored := Win.UnmapViewOfFile (Mapping.Address);
|
|
|
321 Mapping := Invalid_System_Mapping;
|
|
|
322 end Dispose_Mapping;
|
|
|
323
|
|
|
324 -------------------
|
|
|
325 -- Get_Page_Size --
|
|
|
326 -------------------
|
|
|
327
|
|
|
328 function Get_Page_Size return File_Size is
|
|
|
329 SystemInfo : aliased SYSTEM_INFO;
|
|
|
330 begin
|
|
|
331 GetSystemInfo (SystemInfo'Unchecked_Access);
|
|
|
332 return File_Size (SystemInfo.dwAllocationGranularity);
|
|
|
333 end Get_Page_Size;
|
|
|
334
|
|
|
335 -----------
|
|
|
336 -- Align --
|
|
|
337 -----------
|
|
|
338
|
|
|
339 function Align
|
|
|
340 (Addr : File_Size) return File_Size is
|
|
|
341 begin
|
|
|
342 return Addr - Addr mod Get_Page_Size;
|
|
|
343 end Align;
|
|
|
344
|
|
|
345 end System.Mmap.OS_Interface;
|
