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