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