gcc/ada/s-mmosin-unix.adb

   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-2016, 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 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          raise Ada.IO_Exceptions.Name_Error
  61            with "Cannot open " & Filename;
  62       end if;
  63       return
  64         (Fd     => Fd,
  65          Mapped => Use_Mmap_If_Available and then Is_Mapping_Available,
  66          Write  => False,
  67          Length => File_Size (File_Length (Fd)));
  68    end Open_Read;
  69
  70    ----------------
  71    -- Open_Write --
  72    ----------------
  73
  74    function Open_Write
  75      (Filename              : String;
  76       Use_Mmap_If_Available : Boolean := True) return System_File is
  77       Fd : constant File_Descriptor :=
  78         Open_Read_Write (Filename, Binary);
  79    begin
  80       if Fd = Invalid_FD then
  81          raise Ada.IO_Exceptions.Name_Error
  82          with "Cannot open " & Filename;
  83       end if;
  84       return
  85         (Fd     => Fd,
  86          Mapped => Use_Mmap_If_Available and then Is_Mapping_Available,
  87          Write  => True,
  88          Length => File_Size (File_Length (Fd)));
  89    end Open_Write;
  90
  91    -----------
  92    -- Close --
  93    -----------
  94
  95    procedure Close (File : in out System_File) is
  96    begin
  97       Close (File.Fd);
  98       File.Fd := Invalid_FD;
  99    end Close;
 100
 101    --------------------
 102    -- Read_From_Disk --
 103    --------------------
 104
 105    function Read_From_Disk
 106      (File           : System_File;
 107       Offset, Length : File_Size) return System.Strings.String_Access
 108    is
 109       Buffer : String_Access := new String (1 .. Integer (Length));
 110    begin
 111       --  ??? Lseek offset should be a size_t instead of a Long_Integer
 112
 113       Lseek (File.Fd, Long_Integer (Offset), Seek_Set);
 114       if System.OS_Lib.Read (File.Fd, Buffer.all'Address, Integer (Length))
 115         /= Integer (Length)
 116       then
 117          System.Strings.Free (Buffer);
 118          raise Ada.IO_Exceptions.Device_Error;
 119       end if;
 120       return Buffer;
 121    end Read_From_Disk;
 122
 123    -------------------
 124    -- Write_To_Disk --
 125    -------------------
 126
 127    procedure Write_To_Disk
 128      (File           : System_File;
 129       Offset, Length : File_Size;
 130       Buffer         : System.Strings.String_Access) is
 131    begin
 132       pragma Assert (File.Write);
 133       Lseek (File.Fd, Long_Integer (Offset), Seek_Set);
 134       if System.OS_Lib.Write (File.Fd, Buffer.all'Address, Integer (Length))
 135         /= Integer (Length)
 136       then
 137          raise Ada.IO_Exceptions.Device_Error;
 138       end if;
 139    end Write_To_Disk;
 140
 141    --------------------
 142    -- Create_Mapping --
 143    --------------------
 144
 145    procedure Create_Mapping
 146      (File           : System_File;
 147       Offset, Length : in out File_Size;
 148       Mutable        : Boolean;
 149       Mapping        : out System_Mapping)
 150    is
 151       Prot  : Mmap_Prot;
 152       Flags : Mmap_Flags;
 153    begin
 154       if File.Write then
 155          Prot  := PROT_READ + PROT_WRITE;
 156          Flags := MAP_SHARED;
 157       else
 158          Prot := PROT_READ;
 159          if Mutable then
 160             Prot := Prot + PROT_WRITE;
 161          end if;
 162          Flags := MAP_PRIVATE;
 163       end if;
 164
 165       --  Adjust offset and mapping length to account for the required
 166       --  alignment of offset on page boundary.
 167
 168       declare
 169          Queried_Offset : constant File_Size := Offset;
 170       begin
 171          Offset := Align (Offset);
 172
 173          --  First extend the length to compensate the offset shift, then align
 174          --  it on the upper page boundary, so that the whole queried area is
 175          --  covered.
 176
 177          Length := Length + Queried_Offset - Offset;
 178          Length := Align (Length + Get_Page_Size - 1);
 179       end;
 180
 181       if Length > File_Size (Integer'Last) then
 182          raise Ada.IO_Exceptions.Device_Error;
 183       else
 184          Mapping :=
 185            (Address => System.Mmap.Unix.Mmap
 186               (Offset => off_t (Offset),
 187                Length => Interfaces.C.size_t (Length),
 188                Prot   => Prot,
 189                Flags  => Flags,
 190                Fd     => File.Fd),
 191             Length  => Length);
 192       end if;
 193    end Create_Mapping;
 194
 195    ---------------------
 196    -- Dispose_Mapping --
 197    ---------------------
 198
 199    procedure Dispose_Mapping
 200      (Mapping : in out System_Mapping)
 201    is
 202       Ignored : Integer;
 203       pragma Unreferenced (Ignored);
 204    begin
 205       Ignored := Munmap
 206         (Mapping.Address, Interfaces.C.size_t (Mapping.Length));
 207       Mapping := Invalid_System_Mapping;
 208    end Dispose_Mapping;
 209
 210    -------------------
 211    -- Get_Page_Size --
 212    -------------------
 213
 214    function Get_Page_Size return File_Size is
 215       function Internal return Integer;
 216       pragma Import (C, Internal, "getpagesize");
 217    begin
 218       return File_Size (Internal);
 219    end Get_Page_Size;
 220
 221    -----------
 222    -- Align --
 223    -----------
 224
 225    function Align
 226      (Addr : File_Size) return File_Size is
 227    begin
 228       return Addr - Addr mod Get_Page_Size;
 229    end Align;
 230
 231 end System.Mmap.OS_Interface;