|
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 -- --
|
|
145
|
9 -- Copyright (C) 2007-2019, 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; use System;
|
|
|
34
|
|
|
35 with System.OS_Lib; use System.OS_Lib;
|
|
|
36 with System.Mmap.Unix; use System.Mmap.Unix;
|
|
|
37
|
|
|
38 package 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
|
|
|
229 end System.Mmap.OS_Interface;
|
