gcc/ada/libgnat/s-mmap.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                          S Y S T E M . M M A P                           --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   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 with Ada.IO_Exceptions;
  33 with Ada.Unchecked_Conversion;
  34 with Ada.Unchecked_Deallocation;
  35
  36 with System.Strings; use System.Strings;
  37
  38 with System.Mmap.OS_Interface; use System.Mmap.OS_Interface;
  39
  40 package body System.Mmap is
  41
  42    type Mapped_File_Record is record
  43       Current_Region     : Mapped_Region;
  44       --  The legacy API enables only one region to be mapped, directly
  45       --  associated with the mapped file. This references this region.
  46
  47       File               : System_File;
  48       --  Underlying OS-level file
  49    end record;
  50
  51    type Mapped_Region_Record is record
  52       File          : Mapped_File;
  53       --  The file this region comes from. Be careful: for reading file, it is
  54       --  valid to have it closed before one of its regions is free'd.
  55
  56       Write         : Boolean;
  57       --  Whether the file this region comes from is open for writing.
  58
  59       Data          : Str_Access;
  60       --  Unbounded access to the mapped content.
  61
  62       System_Offset : File_Size;
  63       --  Position in the file of the first byte actually mapped in memory
  64
  65       User_Offset   : File_Size;
  66       --  Position in the file of the first byte requested by the user
  67
  68       System_Size   : File_Size;
  69       --  Size of the region actually mapped in memory
  70
  71       User_Size     : File_Size;
  72       --  Size of the region requested by the user
  73
  74       Mapped        : Boolean;
  75       --  Whether this region is actually memory mapped
  76
  77       Mutable       : Boolean;
  78       --  If the file is opened for reading, wheter this region is writable
  79
  80       Buffer        : System.Strings.String_Access;
  81       --  When this region is not actually memory mapped, contains the
  82       --  requested bytes.
  83
  84       Mapping       : System_Mapping;
  85       --  Underlying OS-level data for the mapping, if any
  86    end record;
  87
  88    Invalid_Mapped_Region_Record : constant Mapped_Region_Record :=
  89      (null, False, null, 0, 0, 0, 0, False, False, null,
  90       Invalid_System_Mapping);
  91    Invalid_Mapped_File_Record : constant Mapped_File_Record :=
  92      (Invalid_Mapped_Region, Invalid_System_File);
  93
  94    Empty_String : constant String := "";
  95    --  Used to provide a valid empty Data for empty files, for instanc.
  96
  97    procedure Dispose is new Ada.Unchecked_Deallocation
  98      (Mapped_File_Record, Mapped_File);
  99    procedure Dispose is new Ada.Unchecked_Deallocation
 100      (Mapped_Region_Record, Mapped_Region);
 101
 102    function Convert is new Ada.Unchecked_Conversion
 103      (Standard.System.Address, Str_Access);
 104
 105    procedure Compute_Data (Region : Mapped_Region);
 106    --  Fill the Data field according to system and user offsets. The region
 107    --  must actually be mapped or bufferized.
 108
 109    procedure From_Disk (Region : Mapped_Region);
 110    --  Read a region of some file from the disk
 111
 112    procedure To_Disk (Region : Mapped_Region);
 113    --  Write the region of the file back to disk if necessary, and free memory
 114
 115    ----------------------------
 116    -- Open_Read_No_Exception --
 117    ----------------------------
 118
 119    function Open_Read_No_Exception
 120      (Filename              : String;
 121       Use_Mmap_If_Available : Boolean := True) return Mapped_File
 122    is
 123       File : constant System_File :=
 124          Open_Read (Filename, Use_Mmap_If_Available);
 125    begin
 126       if File = Invalid_System_File then
 127          return Invalid_Mapped_File;
 128       end if;
 129
 130       return new Mapped_File_Record'
 131         (Current_Region => Invalid_Mapped_Region,
 132          File           => File);
 133    end Open_Read_No_Exception;
 134
 135    ---------------
 136    -- Open_Read --
 137    ---------------
 138
 139    function Open_Read
 140      (Filename              : String;
 141       Use_Mmap_If_Available : Boolean := True) return Mapped_File
 142    is
 143       Res : constant Mapped_File :=
 144         Open_Read_No_Exception (Filename, Use_Mmap_If_Available);
 145    begin
 146       if Res = Invalid_Mapped_File then
 147          raise Ada.IO_Exceptions.Name_Error
 148            with "Cannot open " & Filename;
 149       else
 150          return Res;
 151       end if;
 152    end Open_Read;
 153
 154    ----------------
 155    -- Open_Write --
 156    ----------------
 157
 158    function Open_Write
 159      (Filename              : String;
 160       Use_Mmap_If_Available : Boolean := True) return Mapped_File
 161    is
 162       File : constant System_File :=
 163          Open_Write (Filename, Use_Mmap_If_Available);
 164    begin
 165       if File = Invalid_System_File then
 166          raise Ada.IO_Exceptions.Name_Error
 167            with "Cannot open " & Filename;
 168       else
 169          return new Mapped_File_Record'
 170            (Current_Region => Invalid_Mapped_Region,
 171             File           => File);
 172       end if;
 173    end Open_Write;
 174
 175    -----------
 176    -- Close --
 177    -----------
 178
 179    procedure Close (File : in out Mapped_File) is
 180    begin
 181       --  Closing a closed file is allowed and should do nothing
 182
 183       if File = Invalid_Mapped_File then
 184          return;
 185       end if;
 186
 187       if File.Current_Region /= null then
 188          Free (File.Current_Region);
 189       end if;
 190
 191       if File.File /= Invalid_System_File then
 192          Close (File.File);
 193       end if;
 194
 195       Dispose (File);
 196    end Close;
 197
 198    ----------
 199    -- Free --
 200    ----------
 201
 202    procedure Free (Region : in out Mapped_Region) is
 203       Ignored : Integer;
 204       pragma Unreferenced (Ignored);
 205    begin
 206       --  Freeing an already free'd file is allowed and should do nothing
 207
 208       if Region = Invalid_Mapped_Region then
 209          return;
 210       end if;
 211
 212       if Region.Mapping /= Invalid_System_Mapping then
 213          Dispose_Mapping (Region.Mapping);
 214       end if;
 215       To_Disk (Region);
 216       Dispose (Region);
 217    end Free;
 218
 219    ----------
 220    -- Read --
 221    ----------
 222
 223    procedure Read
 224      (File    : Mapped_File;
 225       Region  : in out Mapped_Region;
 226       Offset  : File_Size := 0;
 227       Length  : File_Size := 0;
 228       Mutable : Boolean := False)
 229    is
 230       File_Length      : constant File_Size := Mmap.Length (File);
 231
 232       Req_Offset       : constant File_Size := Offset;
 233       Req_Length       : File_Size := Length;
 234       --  Offset and Length of the region to map, used to adjust mapping
 235       --  bounds, reflecting what the user will see.
 236
 237       Region_Allocated : Boolean := False;
 238    begin
 239       --  If this region comes from another file, or simply if the file is
 240       --  writeable, we cannot re-use this mapping: free it first.
 241
 242       if Region /= Invalid_Mapped_Region
 243         and then
 244           (Region.File /= File or else File.File.Write)
 245       then
 246          Free (Region);
 247       end if;
 248
 249       if Region = Invalid_Mapped_Region then
 250          Region := new Mapped_Region_Record'(Invalid_Mapped_Region_Record);
 251          Region_Allocated := True;
 252       end if;
 253
 254       Region.File := File;
 255
 256       if Req_Offset >= File_Length then
 257          --  If the requested offset goes beyond file size, map nothing
 258
 259          Req_Length := 0;
 260
 261       elsif Length = 0
 262         or else
 263           Length > File_Length - Req_Offset
 264       then
 265          --  If Length is 0 or goes beyond file size, map till end of file
 266
 267          Req_Length := File_Length - Req_Offset;
 268
 269       else
 270          Req_Length := Length;
 271       end if;
 272
 273       --  Past this point, the offset/length the user will see is fixed. On the
 274       --  other hand, the system offset/length is either already defined, from
 275       --  a previous mapping, or it is set to 0. In the latter case, the next
 276       --  step will set them according to the mapping.
 277
 278       Region.User_Offset := Req_Offset;
 279       Region.User_Size := Req_Length;
 280
 281       --  If the requested region is inside an already mapped region, adjust
 282       --  user-requested data and do nothing else.
 283
 284       if (File.File.Write or else Region.Mutable = Mutable)
 285         and then
 286         Req_Offset >= Region.System_Offset
 287         and then
 288             (Req_Offset + Req_Length
 289              <= Region.System_Offset + Region.System_Size)
 290       then
 291          Region.User_Offset := Req_Offset;
 292          Compute_Data (Region);
 293          return;
 294
 295       elsif Region.Buffer /= null then
 296          --  Otherwise, as we are not going to re-use the buffer, free it
 297
 298          System.Strings.Free (Region.Buffer);
 299          Region.Buffer := null;
 300
 301       elsif Region.Mapping /= Invalid_System_Mapping then
 302          --  Otherwise, there is a memory mapping that we need to unmap.
 303          Dispose_Mapping (Region.Mapping);
 304       end if;
 305
 306       --  mmap() will sometimes return NULL when the file exists but is empty,
 307       --  which is not what we want, so in the case of a zero length file we
 308       --  fall back to read(2)/write(2)-based mode.
 309
 310       if File_Length > 0 and then File.File.Mapped then
 311
 312          Region.System_Offset := Req_Offset;
 313          Region.System_Size := Req_Length;
 314          Create_Mapping
 315            (File.File,
 316             Region.System_Offset, Region.System_Size,
 317             Mutable,
 318             Region.Mapping);
 319          Region.Mapped := True;
 320          Region.Mutable := Mutable;
 321
 322       else
 323          --  There is no alignment requirement when manually reading the file.
 324
 325          Region.System_Offset := Req_Offset;
 326          Region.System_Size := Req_Length;
 327          Region.Mapped := False;
 328          Region.Mutable := True;
 329          From_Disk (Region);
 330       end if;
 331
 332       Region.Write := File.File.Write;
 333       Compute_Data (Region);
 334
 335    exception
 336       when others =>
 337          --  Before propagating any exception, free any region we allocated
 338          --  here.
 339
 340          if Region_Allocated then
 341             Dispose (Region);
 342          end if;
 343          raise;
 344    end Read;
 345
 346    ----------
 347    -- Read --
 348    ----------
 349
 350    procedure Read
 351      (File    : Mapped_File;
 352       Offset  : File_Size := 0;
 353       Length  : File_Size := 0;
 354       Mutable : Boolean := False)
 355    is
 356    begin
 357       Read (File, File.Current_Region, Offset, Length, Mutable);
 358    end Read;
 359
 360    ----------
 361    -- Read --
 362    ----------
 363
 364    function Read
 365      (File    : Mapped_File;
 366       Offset  : File_Size := 0;
 367       Length  : File_Size := 0;
 368       Mutable : Boolean := False) return Mapped_Region
 369    is
 370       Region  : Mapped_Region := Invalid_Mapped_Region;
 371    begin
 372       Read (File, Region, Offset, Length, Mutable);
 373       return Region;
 374    end Read;
 375
 376    ------------
 377    -- Length --
 378    ------------
 379
 380    function Length (File : Mapped_File) return File_Size is
 381    begin
 382       return File.File.Length;
 383    end Length;
 384
 385    ------------
 386    -- Offset --
 387    ------------
 388
 389    function Offset (Region : Mapped_Region) return File_Size is
 390    begin
 391       return Region.User_Offset;
 392    end Offset;
 393
 394    ------------
 395    -- Offset --
 396    ------------
 397
 398    function Offset (File : Mapped_File) return File_Size is
 399    begin
 400       return Offset (File.Current_Region);
 401    end Offset;
 402
 403    ----------
 404    -- Last --
 405    ----------
 406
 407    function Last (Region : Mapped_Region) return Integer is
 408    begin
 409       return Integer (Region.User_Size);
 410    end Last;
 411
 412    ----------
 413    -- Last --
 414    ----------
 415
 416    function Last (File : Mapped_File) return Integer is
 417    begin
 418       return Last (File.Current_Region);
 419    end Last;
 420
 421    -------------------
 422    -- To_Str_Access --
 423    -------------------
 424
 425    function To_Str_Access
 426      (Str : System.Strings.String_Access) return Str_Access is
 427    begin
 428       if Str = null then
 429          return null;
 430       else
 431          return Convert (Str.all'Address);
 432       end if;
 433    end To_Str_Access;
 434
 435    ----------
 436    -- Data --
 437    ----------
 438
 439    function Data (Region : Mapped_Region) return Str_Access is
 440    begin
 441       return Region.Data;
 442    end Data;
 443
 444    ----------
 445    -- Data --
 446    ----------
 447
 448    function Data (File : Mapped_File) return Str_Access is
 449    begin
 450       return Data (File.Current_Region);
 451    end Data;
 452
 453    ----------------
 454    -- Is_Mutable --
 455    ----------------
 456
 457    function Is_Mutable (Region : Mapped_Region) return Boolean is
 458    begin
 459       return Region.Mutable or Region.Write;
 460    end Is_Mutable;
 461
 462    ----------------
 463    -- Is_Mmapped --
 464    ----------------
 465
 466    function Is_Mmapped (File : Mapped_File) return Boolean is
 467    begin
 468       return File.File.Mapped;
 469    end Is_Mmapped;
 470
 471    -------------------
 472    -- Get_Page_Size --
 473    -------------------
 474
 475    function Get_Page_Size return Integer is
 476       Result : constant File_Size := Get_Page_Size;
 477    begin
 478       return Integer (Result);
 479    end Get_Page_Size;
 480
 481    ---------------------
 482    -- Read_Whole_File --
 483    ---------------------
 484
 485    function Read_Whole_File
 486      (Filename           : String;
 487       Empty_If_Not_Found : Boolean := False)
 488      return System.Strings.String_Access
 489    is
 490       File   : Mapped_File := Open_Read (Filename);
 491       Region : Mapped_Region renames File.Current_Region;
 492       Result : String_Access;
 493    begin
 494       Read (File);
 495
 496       if Region.Data /= null then
 497          Result := new String'(String
 498                                (Region.Data (1 .. Last (Region))));
 499
 500       elsif Region.Buffer /= null then
 501          Result := Region.Buffer;
 502          Region.Buffer := null;  --  So that it is not deallocated
 503       end if;
 504
 505       Close (File);
 506
 507       return Result;
 508
 509    exception
 510       when Ada.IO_Exceptions.Name_Error =>
 511          if Empty_If_Not_Found then
 512             return new String'("");
 513          else
 514             return null;
 515          end if;
 516
 517       when others =>
 518          Close (File);
 519          return null;
 520    end Read_Whole_File;
 521
 522    ---------------
 523    -- From_Disk --
 524    ---------------
 525
 526    procedure From_Disk (Region : Mapped_Region) is
 527    begin
 528       pragma Assert (Region.File.all /= Invalid_Mapped_File_Record);
 529       pragma Assert (Region.Buffer = null);
 530
 531       Region.Buffer := Read_From_Disk
 532         (Region.File.File, Region.User_Offset, Region.User_Size);
 533       Region.Mapped := False;
 534    end From_Disk;
 535
 536    -------------
 537    -- To_Disk --
 538    -------------
 539
 540    procedure To_Disk (Region : Mapped_Region) is
 541    begin
 542       if Region.Write and then Region.Buffer /= null then
 543          pragma Assert (Region.File.all /= Invalid_Mapped_File_Record);
 544          Write_To_Disk
 545            (Region.File.File,
 546             Region.User_Offset, Region.User_Size,
 547             Region.Buffer);
 548       end if;
 549
 550       System.Strings.Free (Region.Buffer);
 551       Region.Buffer := null;
 552    end To_Disk;
 553
 554    ------------------
 555    -- Compute_Data --
 556    ------------------
 557
 558    procedure Compute_Data (Region : Mapped_Region) is
 559       Base_Data : Str_Access;
 560       --  Address of the first byte actually mapped in memory
 561
 562       Data_Shift : constant Integer :=
 563         Integer (Region.User_Offset - Region.System_Offset);
 564    begin
 565       if Region.User_Size = 0 then
 566          Region.Data := Convert (Empty_String'Address);
 567          return;
 568       elsif Region.Mapped then
 569          Base_Data := Convert (Region.Mapping.Address);
 570       else
 571          Base_Data := Convert (Region.Buffer.all'Address);
 572       end if;
 573       Region.Data := Convert (Base_Data (Data_Shift + 1)'Address);
 574    end Compute_Data;
 575
 576 end System.Mmap;