diff options
Diffstat (limited to 'gcc/ada/s-mmosin-mingw.adb')
| -rw-r--r-- | gcc/ada/s-mmosin-mingw.adb | 341 |
1 files changed, 341 insertions, 0 deletions
diff --git a/gcc/ada/s-mmosin-mingw.adb b/gcc/ada/s-mmosin-mingw.adb new file mode 100644 index 0000000..0785f3c --- /dev/null +++ b/gcc/ada/s-mmosin-mingw.adb @@ -0,0 +1,341 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . M M A P . O S _ I N T E R F A C E -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2007-2016, AdaCore -- +-- -- +-- This library is free software; you can redistribute it and/or modify it -- +-- under terms of the GNU General Public License as published by the Free -- +-- Software Foundation; either version 3, or (at your option) any later -- +-- version. This library is distributed in the hope that it will be useful, -- +-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- +-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.IO_Exceptions; +with System.Strings; use System.Strings; + +package body System.Mmap.OS_Interface is + + use Win; + + function Align + (Addr : File_Size) return File_Size; + -- Align some offset/length to the lowest page boundary + + function Open_Common + (Filename : String; + Use_Mmap_If_Available : Boolean; + Write : Boolean) return System_File; + + function From_UTF8 (Path : String) return Wide_String; + -- Convert from UTF-8 to Wide_String + + --------------- + -- From_UTF8 -- + --------------- + + function From_UTF8 (Path : String) return Wide_String is + function MultiByteToWideChar + (Codepage : Interfaces.C.unsigned; + Flags : Interfaces.C.unsigned; + Mbstr : Address; + Mb : Natural; + Wcstr : Address; + Wc : Natural) return Integer; + pragma Import (C, MultiByteToWideChar); + + Current_Codepage : Interfaces.C.unsigned; + pragma Import (C, Current_Codepage, "__gnat_current_codepage"); + + Len : Natural; + begin + -- Compute length of the result + Len := MultiByteToWideChar + (Current_Codepage, 0, Path'Address, Path'Length, Null_Address, 0); + if Len = 0 then + raise Constraint_Error; + end if; + + declare + -- Declare result + Res : Wide_String (1 .. Len); + begin + -- And compute it + Len := MultiByteToWideChar + (Current_Codepage, 0, + Path'Address, Path'Length, + Res'Address, Len); + if Len = 0 then + raise Constraint_Error; + end if; + return Res; + end; + end From_UTF8; + + ----------------- + -- Open_Common -- + ----------------- + + function Open_Common + (Filename : String; + Use_Mmap_If_Available : Boolean; + Write : Boolean) return System_File + is + dwDesiredAccess, dwShareMode : DWORD; + PageFlags : DWORD; + + W_Filename : constant Wide_String := + From_UTF8 (Filename) & Wide_Character'Val (0); + File_Handle, Mapping_Handle : HANDLE; + + SizeH : aliased DWORD; + Size : File_Size; + begin + if Write then + dwDesiredAccess := GENERIC_READ + GENERIC_WRITE; + dwShareMode := 0; + PageFlags := Win.PAGE_READWRITE; + else + dwDesiredAccess := GENERIC_READ; + dwShareMode := Win.FILE_SHARE_READ; + PageFlags := Win.PAGE_READONLY; + end if; + + -- Actually open the file + + File_Handle := CreateFile + (W_Filename'Address, dwDesiredAccess, dwShareMode, + null, OPEN_EXISTING, Win.FILE_ATTRIBUTE_NORMAL, 0); + + if File_Handle = Win.INVALID_HANDLE_VALUE then + raise Ada.IO_Exceptions.Name_Error + with "Cannot open " & Filename; + end if; + + -- Compute its size + + Size := File_Size (Win.GetFileSize (File_Handle, SizeH'Access)); + + if Size = Win.INVALID_FILE_SIZE then + raise Ada.IO_Exceptions.Use_Error; + end if; + + if SizeH /= 0 and then File_Size'Size > 32 then + Size := Size + (File_Size (SizeH) * 2 ** 32); + end if; + + -- Then create a mapping object, if needed. On Win32, file memory + -- mapping is always available. + + if Use_Mmap_If_Available then + Mapping_Handle := + Win.CreateFileMapping + (File_Handle, null, PageFlags, + 0, DWORD (Size), Standard.System.Null_Address); + else + Mapping_Handle := Win.INVALID_HANDLE_VALUE; + end if; + + return + (Handle => File_Handle, + Mapped => Use_Mmap_If_Available, + Mapping_Handle => Mapping_Handle, + Write => Write, + Length => Size); + end Open_Common; + + --------------- + -- Open_Read -- + --------------- + + function Open_Read + (Filename : String; + Use_Mmap_If_Available : Boolean := True) return System_File is + begin + return Open_Common (Filename, Use_Mmap_If_Available, False); + end Open_Read; + + ---------------- + -- Open_Write -- + ---------------- + + function Open_Write + (Filename : String; + Use_Mmap_If_Available : Boolean := True) return System_File is + begin + return Open_Common (Filename, Use_Mmap_If_Available, True); + end Open_Write; + + ----------- + -- Close -- + ----------- + + procedure Close (File : in out System_File) is + Ignored : BOOL; + pragma Unreferenced (Ignored); + begin + Ignored := CloseHandle (File.Mapping_Handle); + Ignored := CloseHandle (File.Handle); + File.Handle := Win.INVALID_HANDLE_VALUE; + File.Mapping_Handle := Win.INVALID_HANDLE_VALUE; + end Close; + + -------------------- + -- Read_From_Disk -- + -------------------- + + function Read_From_Disk + (File : System_File; + Offset, Length : File_Size) return System.Strings.String_Access + is + Buffer : String_Access := new String (1 .. Integer (Length)); + + Pos : DWORD; + NbRead : aliased DWORD; + pragma Unreferenced (Pos); + begin + Pos := Win.SetFilePointer + (File.Handle, LONG (Offset), null, Win.FILE_BEGIN); + + if Win.ReadFile + (File.Handle, Buffer.all'Address, + DWORD (Length), NbRead'Unchecked_Access, null) = Win.FALSE + then + System.Strings.Free (Buffer); + raise Ada.IO_Exceptions.Device_Error; + end if; + return Buffer; + end Read_From_Disk; + + ------------------- + -- Write_To_Disk -- + ------------------- + + procedure Write_To_Disk + (File : System_File; + Offset, Length : File_Size; + Buffer : System.Strings.String_Access) + is + Pos : DWORD; + NbWritten : aliased DWORD; + pragma Unreferenced (Pos); + begin + pragma Assert (File.Write); + Pos := Win.SetFilePointer + (File.Handle, LONG (Offset), null, Win.FILE_BEGIN); + + if Win.WriteFile + (File.Handle, Buffer.all'Address, + DWORD (Length), NbWritten'Unchecked_Access, null) = Win.FALSE + then + raise Ada.IO_Exceptions.Device_Error; + end if; + end Write_To_Disk; + + -------------------- + -- Create_Mapping -- + -------------------- + + procedure Create_Mapping + (File : System_File; + Offset, Length : in out File_Size; + Mutable : Boolean; + Mapping : out System_Mapping) + is + Flags : DWORD; + begin + if File.Write then + Flags := Win.FILE_MAP_WRITE; + elsif Mutable then + Flags := Win.FILE_MAP_COPY; + else + Flags := Win.FILE_MAP_READ; + end if; + + -- Adjust offset and mapping length to account for the required + -- alignment of offset on page boundary. + + declare + Queried_Offset : constant File_Size := Offset; + begin + Offset := Align (Offset); + + -- First extend the length to compensate the offset shift, then align + -- it on the upper page boundary, so that the whole queried area is + -- covered. + + Length := Length + Queried_Offset - Offset; + Length := Align (Length + Get_Page_Size - 1); + + -- But do not exceed the length of the file + if Offset + Length > File.Length then + Length := File.Length - Offset; + end if; + end; + + if Length > File_Size (Integer'Last) then + raise Ada.IO_Exceptions.Device_Error; + else + Mapping := Invalid_System_Mapping; + Mapping.Address := + Win.MapViewOfFile + (File.Mapping_Handle, Flags, + 0, DWORD (Offset), SIZE_T (Length)); + Mapping.Length := Length; + end if; + end Create_Mapping; + + --------------------- + -- Dispose_Mapping -- + --------------------- + + procedure Dispose_Mapping + (Mapping : in out System_Mapping) + is + Ignored : BOOL; + pragma Unreferenced (Ignored); + begin + Ignored := Win.UnmapViewOfFile (Mapping.Address); + Mapping := Invalid_System_Mapping; + end Dispose_Mapping; + + ------------------- + -- Get_Page_Size -- + ------------------- + + function Get_Page_Size return File_Size is + SystemInfo : aliased SYSTEM_INFO; + begin + GetSystemInfo (SystemInfo'Unchecked_Access); + return File_Size (SystemInfo.dwAllocationGranularity); + end Get_Page_Size; + + ----------- + -- Align -- + ----------- + + function Align + (Addr : File_Size) return File_Size is + begin + return Addr - Addr mod Get_Page_Size; + end Align; + +end System.Mmap.OS_Interface; |