1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- S Y S T E M . M M A P . O S _ I N T E R F A C E --
9 -- Copyright (C) 2007-2024, AdaCore --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.IO_Exceptions
;
34 with System
.OS_Lib
; use System
.OS_Lib
;
35 with System
.Mmap
.Unix
; use System
.Mmap
.Unix
;
37 package body System
.Mmap
.OS_Interface
is
40 (Addr
: File_Size
) return File_Size
;
41 -- Align some offset/length to the lowest page boundary
43 function Is_Mapping_Available
return Boolean renames
44 System
.Mmap
.Unix
.Is_Mapping_Available
;
45 -- Wheter memory mapping is actually available on this system. It is an
46 -- error to use Create_Mapping and Dispose_Mapping if this is False.
54 Use_Mmap_If_Available
: Boolean := True) return System_File
is
55 Fd
: constant File_Descriptor
:=
56 Open_Read
(Filename
, Binary
);
58 if Fd
= Invalid_FD
then
59 return Invalid_System_File
;
63 Mapped
=> Use_Mmap_If_Available
and then Is_Mapping_Available
,
65 Length
=> File_Size
(File_Length
(Fd
)));
74 Use_Mmap_If_Available
: Boolean := True) return System_File
is
75 Fd
: constant File_Descriptor
:=
76 Open_Read_Write
(Filename
, Binary
);
78 if Fd
= Invalid_FD
then
79 return Invalid_System_File
;
83 Mapped
=> Use_Mmap_If_Available
and then Is_Mapping_Available
,
85 Length
=> File_Size
(File_Length
(Fd
)));
92 procedure Close
(File
: in out System_File
) is
95 File
.Fd
:= Invalid_FD
;
102 function Read_From_Disk
104 Offset
, Length
: File_Size
) return System
.Strings
.String_Access
106 Buffer
: String_Access
:= new String (1 .. Integer (Length
));
108 -- ??? Lseek offset should be a size_t instead of a Long_Integer
110 Lseek
(File
.Fd
, Long_Integer (Offset
), Seek_Set
);
111 if System
.OS_Lib
.Read
(File
.Fd
, Buffer
.all'Address, Integer (Length
))
114 System
.Strings
.Free
(Buffer
);
115 raise Ada
.IO_Exceptions
.Device_Error
;
124 procedure Write_To_Disk
126 Offset
, Length
: File_Size
;
127 Buffer
: System
.Strings
.String_Access
) is
129 pragma Assert
(File
.Write
);
130 Lseek
(File
.Fd
, Long_Integer (Offset
), Seek_Set
);
131 if System
.OS_Lib
.Write
(File
.Fd
, Buffer
.all'Address, Integer (Length
))
134 raise Ada
.IO_Exceptions
.Device_Error
;
142 procedure Create_Mapping
144 Offset
, Length
: in out File_Size
;
146 Mapping
: out System_Mapping
)
152 Prot
:= PROT_READ
+ PROT_WRITE
;
157 Prot
:= Prot
+ PROT_WRITE
;
159 Flags
:= MAP_PRIVATE
;
162 -- Adjust offset and mapping length to account for the required
163 -- alignment of offset on page boundary.
166 Queried_Offset
: constant File_Size
:= Offset
;
168 Offset
:= Align
(Offset
);
170 -- First extend the length to compensate the offset shift, then align
171 -- it on the upper page boundary, so that the whole queried area is
174 Length
:= Length
+ Queried_Offset
- Offset
;
175 Length
:= Align
(Length
+ Get_Page_Size
- 1);
178 if Length
> File_Size
(Integer'Last) then
179 raise Ada
.IO_Exceptions
.Device_Error
;
182 (Address
=> System
.Mmap
.Unix
.Mmap
183 (Offset
=> off_t
(Offset
),
184 Length
=> Interfaces
.C
.size_t
(Length
),
192 ---------------------
193 -- Dispose_Mapping --
194 ---------------------
196 procedure Dispose_Mapping
197 (Mapping
: in out System_Mapping
)
200 pragma Unreferenced
(Ignored
);
203 (Mapping
.Address
, Interfaces
.C
.size_t
(Mapping
.Length
));
204 Mapping
:= Invalid_System_Mapping
;
211 function Get_Page_Size
return File_Size
is
212 function Internal
return Integer;
213 pragma Import
(C
, Internal
, "getpagesize");
215 return File_Size
(Internal
);
223 (Addr
: File_Size
) return File_Size
is
225 return Addr
- Addr
mod Get_Page_Size
;
228 end System
.Mmap
.OS_Interface
;