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-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 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, whether 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 Req_Offset + Req_Length <=
 288                  Region.System_Offset + Region.System_Size
 289       then
 290          Region.User_Offset := Req_Offset;
 291          Compute_Data (Region);
 292          return;
 293
 294       elsif Region.Buffer /= null then
 295          --  Otherwise, as we are not going to re-use the buffer, free it
 296
 297          System.Strings.Free (Region.Buffer);
 298          Region.Buffer := null;
 299
 300       elsif Region.Mapping /= Invalid_System_Mapping then
 301          --  Otherwise, there is a memory mapping that we need to unmap.
 302          Dispose_Mapping (Region.Mapping);
 303       end if;
 304
 305       --  mmap() will sometimes return NULL when the file exists but is empty,
 306       --  which is not what we want, so in the case of a zero length file we
 307       --  fall back to read(2)/write(2)-based mode.
 308
 309       if File_Length > 0 and then File.File.Mapped then
 310
 311          Region.System_Offset := Req_Offset;
 312          Region.System_Size := Req_Length;
 313          Create_Mapping
 314            (File.File,
 315             Region.System_Offset, Region.System_Size,
 316             Mutable,
 317             Region.Mapping);
 318          Region.Mapped := True;
 319          Region.Mutable := Mutable;
 320
 321       else
 322          --  There is no alignment requirement when manually reading the file.
 323
 324          Region.System_Offset := Req_Offset;
 325          Region.System_Size := Req_Length;
 326          Region.Mapped := False;
 327          Region.Mutable := True;
 328          From_Disk (Region);
 329       end if;
 330
 331       Region.Write := File.File.Write;
 332       Compute_Data (Region);
 333
 334    exception
 335       when others =>
 336          --  Before propagating any exception, free any region we allocated
 337          --  here.
 338
 339          if Region_Allocated then
 340             Dispose (Region);
 341          end if;
 342          raise;
 343    end Read;
 344
 345    ----------
 346    -- Read --
 347    ----------
 348
 349    procedure Read
 350      (File    : Mapped_File;
 351       Offset  : File_Size := 0;
 352       Length  : File_Size := 0;
 353       Mutable : Boolean := False)
 354    is
 355    begin
 356       Read (File, File.Current_Region, Offset, Length, Mutable);
 357    end Read;
 358
 359    ----------
 360    -- Read --
 361    ----------
 362
 363    function Read
 364      (File    : Mapped_File;
 365       Offset  : File_Size := 0;
 366       Length  : File_Size := 0;
 367       Mutable : Boolean := False) return Mapped_Region
 368    is
 369       Region : Mapped_Region := Invalid_Mapped_Region;
 370    begin
 371       Read (File, Region, Offset, Length, Mutable);
 372       return Region;
 373    end Read;
 374
 375    ------------
 376    -- Length --
 377    ------------
 378
 379    function Length (File : Mapped_File) return File_Size is
 380    begin
 381       return File.File.Length;
 382    end Length;
 383
 384    ------------
 385    -- Offset --
 386    ------------
 387
 388    function Offset (Region : Mapped_Region) return File_Size is
 389    begin
 390       return Region.User_Offset;
 391    end Offset;
 392
 393    ------------
 394    -- Offset --
 395    ------------
 396
 397    function Offset (File : Mapped_File) return File_Size is
 398    begin
 399       return Offset (File.Current_Region);
 400    end Offset;
 401
 402    ----------
 403    -- Last --
 404    ----------
 405
 406    function Last (Region : Mapped_Region) return Integer is
 407    begin
 408       return Integer (Region.User_Size);
 409    end Last;
 410
 411    ----------
 412    -- Last --
 413    ----------
 414
 415    function Last (File : Mapped_File) return Integer is
 416    begin
 417       return Last (File.Current_Region);
 418    end Last;
 419
 420    -------------------
 421    -- To_Str_Access --
 422    -------------------
 423
 424    function To_Str_Access
 425      (Str : System.Strings.String_Access) return Str_Access is
 426    begin
 427       if Str = null then
 428          return null;
 429       else
 430          return Convert (Str.all'Address);
 431       end if;
 432    end To_Str_Access;
 433
 434    ----------
 435    -- Data --
 436    ----------
 437
 438    function Data (Region : Mapped_Region) return Str_Access is
 439    begin
 440       return Region.Data;
 441    end Data;
 442
 443    ----------
 444    -- Data --
 445    ----------
 446
 447    function Data (File : Mapped_File) return Str_Access is
 448    begin
 449       return Data (File.Current_Region);
 450    end Data;
 451
 452    ----------------
 453    -- Is_Mutable --
 454    ----------------
 455
 456    function Is_Mutable (Region : Mapped_Region) return Boolean is
 457    begin
 458       return Region.Mutable or Region.Write;
 459    end Is_Mutable;
 460
 461    ----------------
 462    -- Is_Mmapped --
 463    ----------------
 464
 465    function Is_Mmapped (File : Mapped_File) return Boolean is
 466    begin
 467       return File.File.Mapped;
 468    end Is_Mmapped;
 469
 470    -------------------
 471    -- Get_Page_Size --
 472    -------------------
 473
 474    function Get_Page_Size return Integer is
 475       Result : constant File_Size := Get_Page_Size;
 476    begin
 477       return Integer (Result);
 478    end Get_Page_Size;
 479
 480    ---------------------
 481    -- Read_Whole_File --
 482    ---------------------
 483
 484    function Read_Whole_File
 485      (Filename           : String;
 486       Empty_If_Not_Found : Boolean := False)
 487      return System.Strings.String_Access
 488    is
 489       File   : Mapped_File := Open_Read (Filename);
 490       Region : Mapped_Region renames File.Current_Region;
 491       Result : String_Access;
 492    begin
 493       Read (File);
 494
 495       if Region.Data /= null then
 496          Result := new String'(String
 497                                (Region.Data (1 .. Last (Region))));
 498
 499       elsif Region.Buffer /= null then
 500          Result := Region.Buffer;
 501          Region.Buffer := null;  --  So that it is not deallocated
 502       end if;
 503
 504       Close (File);
 505
 506       return Result;
 507
 508    exception
 509       when Ada.IO_Exceptions.Name_Error =>
 510          if Empty_If_Not_Found then
 511             return new String'("");
 512          else
 513             return null;
 514          end if;
 515
 516       when others =>
 517          Close (File);
 518          return null;
 519    end Read_Whole_File;
 520
 521    ---------------
 522    -- From_Disk --
 523    ---------------
 524
 525    procedure From_Disk (Region : Mapped_Region) is
 526    begin
 527       pragma Assert (Region.File.all /= Invalid_Mapped_File_Record);
 528       pragma Assert (Region.Buffer = null);
 529
 530       Region.Buffer := Read_From_Disk
 531         (Region.File.File, Region.User_Offset, Region.User_Size);
 532       Region.Mapped := False;
 533    end From_Disk;
 534
 535    -------------
 536    -- To_Disk --
 537    -------------
 538
 539    procedure To_Disk (Region : Mapped_Region) is
 540    begin
 541       if Region.Write and then Region.Buffer /= null then
 542          pragma Assert (Region.File.all /= Invalid_Mapped_File_Record);
 543          Write_To_Disk
 544            (Region.File.File,
 545             Region.User_Offset, Region.User_Size,
 546             Region.Buffer);
 547       end if;
 548
 549       System.Strings.Free (Region.Buffer);
 550       Region.Buffer := null;
 551    end To_Disk;
 552
 553    ------------------
 554    -- Compute_Data --
 555    ------------------
 556
 557    procedure Compute_Data (Region : Mapped_Region) is
 558       Base_Data : Str_Access;
 559       --  Address of the first byte actually mapped in memory
 560
 561       Data_Shift : constant Integer :=
 562         Integer (Region.User_Offset - Region.System_Offset);
 563    begin
 564       if Region.User_Size = 0 then
 565          Region.Data := Convert (Empty_String'Address);
 566          return;
 567       elsif Region.Mapped then
 568          Base_Data := Convert (Region.Mapping.Address);
 569       else
 570          Base_Data := Convert (Region.Buffer.all'Address);
 571       end if;
 572       Region.Data := Convert (Base_Data (Data_Shift + 1)'Address);
 573    end Compute_Data;
 574
 575 end System.Mmap;