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          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
 229 end System.Mmap.OS_Interface;