|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S Y S T E M . M M A P --
|
|
|
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 Ada.Unchecked_Conversion;
|
|
|
34 with Ada.Unchecked_Deallocation;
|
|
|
35
|
|
|
36 with System.Strings; use System.Strings;
|
|
|
37
|
|
|
38 with System.Mmap.OS_Interface; use System.Mmap.OS_Interface;
|
|
|
39
|
|
|
40 package body System.Mmap is
|
|
|
41
|
|
|
42 type Mapped_File_Record is record
|
|
|
43 Current_Region : Mapped_Region;
|
|
|
44 -- The legacy API enables only one region to be mapped, directly
|
|
|
45 -- associated with the mapped file. This references this region.
|
|
|
46
|
|
|
47 File : System_File;
|
|
|
48 -- Underlying OS-level file
|
|
|
49 end record;
|
|
|
50
|
|
|
51 type Mapped_Region_Record is record
|
|
|
52 File : Mapped_File;
|
|
|
53 -- The file this region comes from. Be careful: for reading file, it is
|
|
|
54 -- valid to have it closed before one of its regions is free'd.
|
|
|
55
|
|
|
56 Write : Boolean;
|
|
|
57 -- Whether the file this region comes from is open for writing.
|
|
|
58
|
|
|
59 Data : Str_Access;
|
|
|
60 -- Unbounded access to the mapped content.
|
|
|
61
|
|
|
62 System_Offset : File_Size;
|
|
|
63 -- Position in the file of the first byte actually mapped in memory
|
|
|
64
|
|
|
65 User_Offset : File_Size;
|
|
|
66 -- Position in the file of the first byte requested by the user
|
|
|
67
|
|
|
68 System_Size : File_Size;
|
|
|
69 -- Size of the region actually mapped in memory
|
|
|
70
|
|
|
71 User_Size : File_Size;
|
|
|
72 -- Size of the region requested by the user
|
|
|
73
|
|
|
74 Mapped : Boolean;
|
|
|
75 -- Whether this region is actually memory mapped
|
|
|
76
|
|
|
77 Mutable : Boolean;
|
|
|
78 -- If the file is opened for reading, wheter this region is writable
|
|
|
79
|
|
|
80 Buffer : System.Strings.String_Access;
|
|
|
81 -- When this region is not actually memory mapped, contains the
|
|
|
82 -- requested bytes.
|
|
|
83
|
|
|
84 Mapping : System_Mapping;
|
|
|
85 -- Underlying OS-level data for the mapping, if any
|
|
|
86 end record;
|
|
|
87
|
|
|
88 Invalid_Mapped_Region_Record : constant Mapped_Region_Record :=
|
|
|
89 (null, False, null, 0, 0, 0, 0, False, False, null,
|
|
|
90 Invalid_System_Mapping);
|
|
|
91 Invalid_Mapped_File_Record : constant Mapped_File_Record :=
|
|
|
92 (Invalid_Mapped_Region, Invalid_System_File);
|
|
|
93
|
|
|
94 Empty_String : constant String := "";
|
|
|
95 -- Used to provide a valid empty Data for empty files, for instanc.
|
|
|
96
|
|
|
97 procedure Dispose is new Ada.Unchecked_Deallocation
|
|
|
98 (Mapped_File_Record, Mapped_File);
|
|
|
99 procedure Dispose is new Ada.Unchecked_Deallocation
|
|
|
100 (Mapped_Region_Record, Mapped_Region);
|
|
|
101
|
|
|
102 function Convert is new Ada.Unchecked_Conversion
|
|
|
103 (Standard.System.Address, Str_Access);
|
|
|
104
|
|
|
105 procedure Compute_Data (Region : Mapped_Region);
|
|
|
106 -- Fill the Data field according to system and user offsets. The region
|
|
|
107 -- must actually be mapped or bufferized.
|
|
|
108
|
|
|
109 procedure From_Disk (Region : Mapped_Region);
|
|
|
110 -- Read a region of some file from the disk
|
|
|
111
|
|
|
112 procedure To_Disk (Region : Mapped_Region);
|
|
|
113 -- Write the region of the file back to disk if necessary, and free memory
|
|
|
114
|
|
|
115 ----------------------------
|
|
|
116 -- Open_Read_No_Exception --
|
|
|
117 ----------------------------
|
|
|
118
|
|
|
119 function Open_Read_No_Exception
|
|
|
120 (Filename : String;
|
|
|
121 Use_Mmap_If_Available : Boolean := True) return Mapped_File
|
|
|
122 is
|
|
|
123 File : constant System_File :=
|
|
|
124 Open_Read (Filename, Use_Mmap_If_Available);
|
|
|
125 begin
|
|
|
126 if File = Invalid_System_File then
|
|
|
127 return Invalid_Mapped_File;
|
|
|
128 end if;
|
|
|
129
|
|
|
130 return new Mapped_File_Record'
|
|
|
131 (Current_Region => Invalid_Mapped_Region,
|
|
|
132 File => File);
|
|
|
133 end Open_Read_No_Exception;
|
|
|
134
|
|
|
135 ---------------
|
|
|
136 -- Open_Read --
|
|
|
137 ---------------
|
|
|
138
|
|
|
139 function Open_Read
|
|
|
140 (Filename : String;
|
|
|
141 Use_Mmap_If_Available : Boolean := True) return Mapped_File
|
|
|
142 is
|
|
|
143 Res : constant Mapped_File :=
|
|
|
144 Open_Read_No_Exception (Filename, Use_Mmap_If_Available);
|
|
|
145 begin
|
|
|
146 if Res = Invalid_Mapped_File then
|
|
|
147 raise Ada.IO_Exceptions.Name_Error
|
|
|
148 with "Cannot open " & Filename;
|
|
|
149 else
|
|
|
150 return Res;
|
|
|
151 end if;
|
|
|
152 end Open_Read;
|
|
|
153
|
|
|
154 ----------------
|
|
|
155 -- Open_Write --
|
|
|
156 ----------------
|
|
|
157
|
|
|
158 function Open_Write
|
|
|
159 (Filename : String;
|
|
|
160 Use_Mmap_If_Available : Boolean := True) return Mapped_File
|
|
|
161 is
|
|
|
162 File : constant System_File :=
|
|
|
163 Open_Write (Filename, Use_Mmap_If_Available);
|
|
|
164 begin
|
|
|
165 if File = Invalid_System_File then
|
|
|
166 raise Ada.IO_Exceptions.Name_Error
|
|
|
167 with "Cannot open " & Filename;
|
|
|
168 else
|
|
|
169 return new Mapped_File_Record'
|
|
|
170 (Current_Region => Invalid_Mapped_Region,
|
|
|
171 File => File);
|
|
|
172 end if;
|
|
|
173 end Open_Write;
|
|
|
174
|
|
|
175 -----------
|
|
|
176 -- Close --
|
|
|
177 -----------
|
|
|
178
|
|
|
179 procedure Close (File : in out Mapped_File) is
|
|
|
180 begin
|
|
|
181 -- Closing a closed file is allowed and should do nothing
|
|
|
182
|
|
|
183 if File = Invalid_Mapped_File then
|
|
|
184 return;
|
|
|
185 end if;
|
|
|
186
|
|
|
187 if File.Current_Region /= null then
|
|
|
188 Free (File.Current_Region);
|
|
|
189 end if;
|
|
|
190
|
|
|
191 if File.File /= Invalid_System_File then
|
|
|
192 Close (File.File);
|
|
|
193 end if;
|
|
|
194
|
|
|
195 Dispose (File);
|
|
|
196 end Close;
|
|
|
197
|
|
|
198 ----------
|
|
|
199 -- Free --
|
|
|
200 ----------
|
|
|
201
|
|
|
202 procedure Free (Region : in out Mapped_Region) is
|
|
|
203 Ignored : Integer;
|
|
|
204 pragma Unreferenced (Ignored);
|
|
|
205 begin
|
|
|
206 -- Freeing an already free'd file is allowed and should do nothing
|
|
|
207
|
|
|
208 if Region = Invalid_Mapped_Region then
|
|
|
209 return;
|
|
|
210 end if;
|
|
|
211
|
|
|
212 if Region.Mapping /= Invalid_System_Mapping then
|
|
|
213 Dispose_Mapping (Region.Mapping);
|
|
|
214 end if;
|
|
|
215 To_Disk (Region);
|
|
|
216 Dispose (Region);
|
|
|
217 end Free;
|
|
|
218
|
|
|
219 ----------
|
|
|
220 -- Read --
|
|
|
221 ----------
|
|
|
222
|
|
|
223 procedure Read
|
|
|
224 (File : Mapped_File;
|
|
|
225 Region : in out Mapped_Region;
|
|
|
226 Offset : File_Size := 0;
|
|
|
227 Length : File_Size := 0;
|
|
|
228 Mutable : Boolean := False)
|
|
|
229 is
|
|
|
230 File_Length : constant File_Size := Mmap.Length (File);
|
|
|
231
|
|
|
232 Req_Offset : constant File_Size := Offset;
|
|
|
233 Req_Length : File_Size := Length;
|
|
|
234 -- Offset and Length of the region to map, used to adjust mapping
|
|
|
235 -- bounds, reflecting what the user will see.
|
|
|
236
|
|
|
237 Region_Allocated : Boolean := False;
|
|
|
238 begin
|
|
|
239 -- If this region comes from another file, or simply if the file is
|
|
|
240 -- writeable, we cannot re-use this mapping: free it first.
|
|
|
241
|
|
|
242 if Region /= Invalid_Mapped_Region
|
|
|
243 and then
|
|
|
244 (Region.File /= File or else File.File.Write)
|
|
|
245 then
|
|
|
246 Free (Region);
|
|
|
247 end if;
|
|
|
248
|
|
|
249 if Region = Invalid_Mapped_Region then
|
|
|
250 Region := new Mapped_Region_Record'(Invalid_Mapped_Region_Record);
|
|
|
251 Region_Allocated := True;
|
|
|
252 end if;
|
|
|
253
|
|
|
254 Region.File := File;
|
|
|
255
|
|
|
256 if Req_Offset >= File_Length then
|
|
|
257 -- If the requested offset goes beyond file size, map nothing
|
|
|
258
|
|
|
259 Req_Length := 0;
|
|
|
260
|
|
|
261 elsif Length = 0
|
|
|
262 or else
|
|
|
263 Length > File_Length - Req_Offset
|
|
|
264 then
|
|
|
265 -- If Length is 0 or goes beyond file size, map till end of file
|
|
|
266
|
|
|
267 Req_Length := File_Length - Req_Offset;
|
|
|
268
|
|
|
269 else
|
|
|
270 Req_Length := Length;
|
|
|
271 end if;
|
|
|
272
|
|
|
273 -- Past this point, the offset/length the user will see is fixed. On the
|
|
|
274 -- other hand, the system offset/length is either already defined, from
|
|
|
275 -- a previous mapping, or it is set to 0. In the latter case, the next
|
|
|
276 -- step will set them according to the mapping.
|
|
|
277
|
|
|
278 Region.User_Offset := Req_Offset;
|
|
|
279 Region.User_Size := Req_Length;
|
|
|
280
|
|
|
281 -- If the requested region is inside an already mapped region, adjust
|
|
|
282 -- user-requested data and do nothing else.
|
|
|
283
|
|
|
284 if (File.File.Write or else Region.Mutable = Mutable)
|
|
|
285 and then
|
|
|
286 Req_Offset >= Region.System_Offset
|
|
|
287 and then
|
|
|
288 (Req_Offset + Req_Length
|
|
|
289 <= Region.System_Offset + Region.System_Size)
|
|
|
290 then
|
|
|
291 Region.User_Offset := Req_Offset;
|
|
|
292 Compute_Data (Region);
|
|
|
293 return;
|
|
|
294
|
|
|
295 elsif Region.Buffer /= null then
|
|
|
296 -- Otherwise, as we are not going to re-use the buffer, free it
|
|
|
297
|
|
|
298 System.Strings.Free (Region.Buffer);
|
|
|
299 Region.Buffer := null;
|
|
|
300
|
|
|
301 elsif Region.Mapping /= Invalid_System_Mapping then
|
|
|
302 -- Otherwise, there is a memory mapping that we need to unmap.
|
|
|
303 Dispose_Mapping (Region.Mapping);
|
|
|
304 end if;
|
|
|
305
|
|
|
306 -- mmap() will sometimes return NULL when the file exists but is empty,
|
|
|
307 -- which is not what we want, so in the case of a zero length file we
|
|
|
308 -- fall back to read(2)/write(2)-based mode.
|
|
|
309
|
|
|
310 if File_Length > 0 and then File.File.Mapped then
|
|
|
311
|
|
|
312 Region.System_Offset := Req_Offset;
|
|
|
313 Region.System_Size := Req_Length;
|
|
|
314 Create_Mapping
|
|
|
315 (File.File,
|
|
|
316 Region.System_Offset, Region.System_Size,
|
|
|
317 Mutable,
|
|
|
318 Region.Mapping);
|
|
|
319 Region.Mapped := True;
|
|
|
320 Region.Mutable := Mutable;
|
|
|
321
|
|
|
322 else
|
|
|
323 -- There is no alignment requirement when manually reading the file.
|
|
|
324
|
|
|
325 Region.System_Offset := Req_Offset;
|
|
|
326 Region.System_Size := Req_Length;
|
|
|
327 Region.Mapped := False;
|
|
|
328 Region.Mutable := True;
|
|
|
329 From_Disk (Region);
|
|
|
330 end if;
|
|
|
331
|
|
|
332 Region.Write := File.File.Write;
|
|
|
333 Compute_Data (Region);
|
|
|
334
|
|
|
335 exception
|
|
|
336 when others =>
|
|
|
337 -- Before propagating any exception, free any region we allocated
|
|
|
338 -- here.
|
|
|
339
|
|
|
340 if Region_Allocated then
|
|
|
341 Dispose (Region);
|
|
|
342 end if;
|
|
|
343 raise;
|
|
|
344 end Read;
|
|
|
345
|
|
|
346 ----------
|
|
|
347 -- Read --
|
|
|
348 ----------
|
|
|
349
|
|
|
350 procedure Read
|
|
|
351 (File : Mapped_File;
|
|
|
352 Offset : File_Size := 0;
|
|
|
353 Length : File_Size := 0;
|
|
|
354 Mutable : Boolean := False)
|
|
|
355 is
|
|
|
356 begin
|
|
|
357 Read (File, File.Current_Region, Offset, Length, Mutable);
|
|
|
358 end Read;
|
|
|
359
|
|
|
360 ----------
|
|
|
361 -- Read --
|
|
|
362 ----------
|
|
|
363
|
|
|
364 function Read
|
|
|
365 (File : Mapped_File;
|
|
|
366 Offset : File_Size := 0;
|
|
|
367 Length : File_Size := 0;
|
|
|
368 Mutable : Boolean := False) return Mapped_Region
|
|
|
369 is
|
|
|
370 Region : Mapped_Region := Invalid_Mapped_Region;
|
|
|
371 begin
|
|
|
372 Read (File, Region, Offset, Length, Mutable);
|
|
|
373 return Region;
|
|
|
374 end Read;
|
|
|
375
|
|
|
376 ------------
|
|
|
377 -- Length --
|
|
|
378 ------------
|
|
|
379
|
|
|
380 function Length (File : Mapped_File) return File_Size is
|
|
|
381 begin
|
|
|
382 return File.File.Length;
|
|
|
383 end Length;
|
|
|
384
|
|
|
385 ------------
|
|
|
386 -- Offset --
|
|
|
387 ------------
|
|
|
388
|
|
|
389 function Offset (Region : Mapped_Region) return File_Size is
|
|
|
390 begin
|
|
|
391 return Region.User_Offset;
|
|
|
392 end Offset;
|
|
|
393
|
|
|
394 ------------
|
|
|
395 -- Offset --
|
|
|
396 ------------
|
|
|
397
|
|
|
398 function Offset (File : Mapped_File) return File_Size is
|
|
|
399 begin
|
|
|
400 return Offset (File.Current_Region);
|
|
|
401 end Offset;
|
|
|
402
|
|
|
403 ----------
|
|
|
404 -- Last --
|
|
|
405 ----------
|
|
|
406
|
|
|
407 function Last (Region : Mapped_Region) return Integer is
|
|
|
408 begin
|
|
|
409 return Integer (Region.User_Size);
|
|
|
410 end Last;
|
|
|
411
|
|
|
412 ----------
|
|
|
413 -- Last --
|
|
|
414 ----------
|
|
|
415
|
|
|
416 function Last (File : Mapped_File) return Integer is
|
|
|
417 begin
|
|
|
418 return Last (File.Current_Region);
|
|
|
419 end Last;
|
|
|
420
|
|
|
421 -------------------
|
|
|
422 -- To_Str_Access --
|
|
|
423 -------------------
|
|
|
424
|
|
|
425 function To_Str_Access
|
|
|
426 (Str : System.Strings.String_Access) return Str_Access is
|
|
|
427 begin
|
|
|
428 if Str = null then
|
|
|
429 return null;
|
|
|
430 else
|
|
|
431 return Convert (Str.all'Address);
|
|
|
432 end if;
|
|
|
433 end To_Str_Access;
|
|
|
434
|
|
|
435 ----------
|
|
|
436 -- Data --
|
|
|
437 ----------
|
|
|
438
|
|
|
439 function Data (Region : Mapped_Region) return Str_Access is
|
|
|
440 begin
|
|
|
441 return Region.Data;
|
|
|
442 end Data;
|
|
|
443
|
|
|
444 ----------
|
|
|
445 -- Data --
|
|
|
446 ----------
|
|
|
447
|
|
|
448 function Data (File : Mapped_File) return Str_Access is
|
|
|
449 begin
|
|
|
450 return Data (File.Current_Region);
|
|
|
451 end Data;
|
|
|
452
|
|
|
453 ----------------
|
|
|
454 -- Is_Mutable --
|
|
|
455 ----------------
|
|
|
456
|
|
|
457 function Is_Mutable (Region : Mapped_Region) return Boolean is
|
|
|
458 begin
|
|
|
459 return Region.Mutable or Region.Write;
|
|
|
460 end Is_Mutable;
|
|
|
461
|
|
|
462 ----------------
|
|
|
463 -- Is_Mmapped --
|
|
|
464 ----------------
|
|
|
465
|
|
|
466 function Is_Mmapped (File : Mapped_File) return Boolean is
|
|
|
467 begin
|
|
|
468 return File.File.Mapped;
|
|
|
469 end Is_Mmapped;
|
|
|
470
|
|
|
471 -------------------
|
|
|
472 -- Get_Page_Size --
|
|
|
473 -------------------
|
|
|
474
|
|
|
475 function Get_Page_Size return Integer is
|
|
|
476 Result : constant File_Size := Get_Page_Size;
|
|
|
477 begin
|
|
|
478 return Integer (Result);
|
|
|
479 end Get_Page_Size;
|
|
|
480
|
|
|
481 ---------------------
|
|
|
482 -- Read_Whole_File --
|
|
|
483 ---------------------
|
|
|
484
|
|
|
485 function Read_Whole_File
|
|
|
486 (Filename : String;
|
|
|
487 Empty_If_Not_Found : Boolean := False)
|
|
|
488 return System.Strings.String_Access
|
|
|
489 is
|
|
|
490 File : Mapped_File := Open_Read (Filename);
|
|
|
491 Region : Mapped_Region renames File.Current_Region;
|
|
|
492 Result : String_Access;
|
|
|
493 begin
|
|
|
494 Read (File);
|
|
|
495
|
|
|
496 if Region.Data /= null then
|
|
|
497 Result := new String'(String
|
|
|
498 (Region.Data (1 .. Last (Region))));
|
|
|
499
|
|
|
500 elsif Region.Buffer /= null then
|
|
|
501 Result := Region.Buffer;
|
|
|
502 Region.Buffer := null; -- So that it is not deallocated
|
|
|
503 end if;
|
|
|
504
|
|
|
505 Close (File);
|
|
|
506
|
|
|
507 return Result;
|
|
|
508
|
|
|
509 exception
|
|
|
510 when Ada.IO_Exceptions.Name_Error =>
|
|
|
511 if Empty_If_Not_Found then
|
|
|
512 return new String'("");
|
|
|
513 else
|
|
|
514 return null;
|
|
|
515 end if;
|
|
|
516
|
|
|
517 when others =>
|
|
|
518 Close (File);
|
|
|
519 return null;
|
|
|
520 end Read_Whole_File;
|
|
|
521
|
|
|
522 ---------------
|
|
|
523 -- From_Disk --
|
|
|
524 ---------------
|
|
|
525
|
|
|
526 procedure From_Disk (Region : Mapped_Region) is
|
|
|
527 begin
|
|
|
528 pragma Assert (Region.File.all /= Invalid_Mapped_File_Record);
|
|
|
529 pragma Assert (Region.Buffer = null);
|
|
|
530
|
|
|
531 Region.Buffer := Read_From_Disk
|
|
|
532 (Region.File.File, Region.User_Offset, Region.User_Size);
|
|
|
533 Region.Mapped := False;
|
|
|
534 end From_Disk;
|
|
|
535
|
|
|
536 -------------
|
|
|
537 -- To_Disk --
|
|
|
538 -------------
|
|
|
539
|
|
|
540 procedure To_Disk (Region : Mapped_Region) is
|
|
|
541 begin
|
|
|
542 if Region.Write and then Region.Buffer /= null then
|
|
|
543 pragma Assert (Region.File.all /= Invalid_Mapped_File_Record);
|
|
|
544 Write_To_Disk
|
|
|
545 (Region.File.File,
|
|
|
546 Region.User_Offset, Region.User_Size,
|
|
|
547 Region.Buffer);
|
|
|
548 end if;
|
|
|
549
|
|
|
550 System.Strings.Free (Region.Buffer);
|
|
|
551 Region.Buffer := null;
|
|
|
552 end To_Disk;
|
|
|
553
|
|
|
554 ------------------
|
|
|
555 -- Compute_Data --
|
|
|
556 ------------------
|
|
|
557
|
|
|
558 procedure Compute_Data (Region : Mapped_Region) is
|
|
|
559 Base_Data : Str_Access;
|
|
|
560 -- Address of the first byte actually mapped in memory
|
|
|
561
|
|
|
562 Data_Shift : constant Integer :=
|
|
|
563 Integer (Region.User_Offset - Region.System_Offset);
|
|
|
564 begin
|
|
|
565 if Region.User_Size = 0 then
|
|
|
566 Region.Data := Convert (Empty_String'Address);
|
|
|
567 return;
|
|
|
568 elsif Region.Mapped then
|
|
|
569 Base_Data := Convert (Region.Mapping.Address);
|
|
|
570 else
|
|
|
571 Base_Data := Convert (Region.Buffer.all'Address);
|
|
|
572 end if;
|
|
|
573 Region.Data := Convert (Base_Data (Data_Shift + 1)'Address);
|
|
|
574 end Compute_Data;
|
|
|
575
|
|
|
576 end System.Mmap;
|
