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--                                 S p e c                                  --
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
32--  OS pecularities abstraction package for Win32 systems.
33
34package System.Mmap.OS_Interface is
35
36   --  The Win package contains copy of definition found in recent System.Win32
37   --  unit provided with the GNAT compiler. The copy is needed to be able to
38   --  compile this unit with older compilers. Note that this internal Win
39   --  package can be removed when GNAT 6.1.0 is not supported anymore.
40
41   package Win is
42
43      subtype PVOID is Standard.System.Address;
44
45      type HANDLE is new Interfaces.C.ptrdiff_t;
46
47      type WORD   is new Interfaces.C.unsigned_short;
48      type DWORD  is new Interfaces.C.unsigned_long;
49      type LONG   is new Interfaces.C.long;
50      type SIZE_T is new Interfaces.C.size_t;
51
52      type BOOL   is new Interfaces.C.int;
53      for BOOL'Size use Interfaces.C.int'Size;
54
55      FALSE : constant := 0;
56
57      GENERIC_READ  : constant := 16#80000000#;
58      GENERIC_WRITE : constant := 16#40000000#;
59      OPEN_EXISTING : constant := 3;
60
61      type OVERLAPPED is record
62         Internal     : DWORD;
63         InternalHigh : DWORD;
64         Offset       : DWORD;
65         OffsetHigh   : DWORD;
66         hEvent       : HANDLE;
67      end record;
68
69      type SECURITY_ATTRIBUTES is record
70         nLength             : DWORD;
71         pSecurityDescriptor : PVOID;
72         bInheritHandle      : BOOL;
73      end record;
74
75      type SYSTEM_INFO is record
76         dwOemId : DWORD;
77         dwPageSize : DWORD;
78         lpMinimumApplicationAddress : PVOID;
79         lpMaximumApplicationAddress : PVOID;
80         dwActiveProcessorMask       : PVOID;
81         dwNumberOfProcessors        : DWORD;
82         dwProcessorType             : DWORD;
83         dwAllocationGranularity     : DWORD;
84         wProcessorLevel             : WORD;
85         wProcessorRevision          : WORD;
86      end record;
87      type LP_SYSTEM_INFO is access all SYSTEM_INFO;
88
89      INVALID_HANDLE_VALUE  : constant HANDLE := -1;
90      FILE_BEGIN            : constant := 0;
91      FILE_SHARE_READ       : constant := 16#00000001#;
92      FILE_ATTRIBUTE_NORMAL : constant := 16#00000080#;
93      FILE_MAP_COPY         : constant := 1;
94      FILE_MAP_READ         : constant := 4;
95      FILE_MAP_WRITE        : constant := 2;
96      PAGE_READONLY         : constant := 16#0002#;
97      PAGE_READWRITE        : constant := 16#0004#;
98      INVALID_FILE_SIZE     : constant := 16#FFFFFFFF#;
99
100      function CreateFile
101        (lpFileName            : Standard.System.Address;
102         dwDesiredAccess       : DWORD;
103         dwShareMode           : DWORD;
104         lpSecurityAttributes  : access SECURITY_ATTRIBUTES;
105         dwCreationDisposition : DWORD;
106         dwFlagsAndAttributes  : DWORD;
107         hTemplateFile         : HANDLE) return HANDLE;
108      pragma Import (Stdcall, CreateFile, "CreateFileW");
109
110      function WriteFile
111        (hFile                  : HANDLE;
112         lpBuffer               : Standard.System.Address;
113         nNumberOfBytesToWrite  : DWORD;
114         lpNumberOfBytesWritten : access DWORD;
115         lpOverlapped           : access OVERLAPPED) return BOOL;
116      pragma Import (Stdcall, WriteFile, "WriteFile");
117
118      function ReadFile
119        (hFile                : HANDLE;
120         lpBuffer             : Standard.System.Address;
121         nNumberOfBytesToRead : DWORD;
122         lpNumberOfBytesRead  : access DWORD;
123         lpOverlapped         : access OVERLAPPED) return BOOL;
124      pragma Import (Stdcall, ReadFile, "ReadFile");
125
126      function CloseHandle (hObject : HANDLE) return BOOL;
127      pragma Import (Stdcall, CloseHandle, "CloseHandle");
128
129      function GetFileSize
130        (hFile : HANDLE; lpFileSizeHigh : access DWORD) return DWORD;
131      pragma Import (Stdcall, GetFileSize, "GetFileSize");
132
133      function SetFilePointer
134        (hFile                : HANDLE;
135         lDistanceToMove      : LONG;
136         lpDistanceToMoveHigh : access LONG;
137         dwMoveMethod         : DWORD) return DWORD;
138      pragma Import (Stdcall, SetFilePointer, "SetFilePointer");
139
140      function CreateFileMapping
141        (hFile                : HANDLE;
142         lpSecurityAttributes : access SECURITY_ATTRIBUTES;
143         flProtect            : DWORD;
144         dwMaximumSizeHigh    : DWORD;
145         dwMaximumSizeLow     : DWORD;
146         lpName               : Standard.System.Address) return HANDLE;
147      pragma Import (Stdcall, CreateFileMapping, "CreateFileMappingW");
148
149      function MapViewOfFile
150        (hFileMappingObject   : HANDLE;
151         dwDesiredAccess      : DWORD;
152         dwFileOffsetHigh     : DWORD;
153         dwFileOffsetLow      : DWORD;
154         dwNumberOfBytesToMap : SIZE_T) return Standard.System.Address;
155      pragma Import (Stdcall, MapViewOfFile, "MapViewOfFile");
156
157      function UnmapViewOfFile
158         (lpBaseAddress : Standard.System.Address) return BOOL;
159      pragma Import (Stdcall, UnmapViewOfFile, "UnmapViewOfFile");
160
161      procedure GetSystemInfo (lpSystemInfo : LP_SYSTEM_INFO);
162      pragma Import (Stdcall, GetSystemInfo, "GetSystemInfo");
163
164   end Win;
165
166   type System_File is record
167      Handle         : Win.HANDLE;
168
169      Mapped         : Boolean;
170      --  Whether mapping is requested by the user and available on the system
171
172      Mapping_Handle : Win.HANDLE;
173
174      Write          : Boolean;
175      --  Whether this file can be written to
176
177      Length         : File_Size;
178      --  Length of the file. Used to know what can be mapped in the file
179   end record;
180
181   type System_Mapping is record
182      Address        : Standard.System.Address;
183      Length         : File_Size;
184   end record;
185
186   Invalid_System_File    : constant System_File :=
187     (Win.INVALID_HANDLE_VALUE, False, Win.INVALID_HANDLE_VALUE, False, 0);
188   Invalid_System_Mapping : constant System_Mapping :=
189     (Standard.System.Null_Address, 0);
190
191   function Open_Read
192     (Filename              : String;
193      Use_Mmap_If_Available : Boolean := True) return System_File;
194   --  Open a file for reading and return the corresponding System_File. Return
195   --  Invalid_System_File if unsuccessful.
196
197   function Open_Write
198     (Filename              : String;
199      Use_Mmap_If_Available : Boolean := True) return System_File;
200   --  Likewise for writing to a file
201
202   procedure Close (File : in out System_File);
203   --  Close a system file
204
205   function Read_From_Disk
206     (File           : System_File;
207      Offset, Length : File_Size) return System.Strings.String_Access;
208   --  Read a fragment of a file. It is up to the caller to free the result
209   --  when done with it.
210
211   procedure Write_To_Disk
212     (File           : System_File;
213      Offset, Length : File_Size;
214      Buffer         : System.Strings.String_Access);
215   --  Write some content to a fragment of a file
216
217   procedure Create_Mapping
218     (File           : System_File;
219      Offset, Length : in out File_Size;
220      Mutable        : Boolean;
221      Mapping        : out System_Mapping);
222   --  Create a memory mapping for the given File, for the area starting at
223   --  Offset and containing Length bytes. Store it to Mapping.
224   --  Note that Offset and Length may be modified according to the system
225   --  needs (for boudaries, for instance). The caller must cope with actually
226   --  wider mapped areas.
227
228   procedure Dispose_Mapping
229     (Mapping : in out System_Mapping);
230   --  Unmap a previously-created mapping
231
232   function Get_Page_Size return File_Size;
233   --  Return the number of bytes in a system page.
234
235end System.Mmap.OS_Interface;
236