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-2020, 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 32with Ada.IO_Exceptions; 33with Ada.Unchecked_Conversion; 34with Ada.Unchecked_Deallocation; 35 36with System.Strings; use System.Strings; 37 38with System.Mmap.OS_Interface; use System.Mmap.OS_Interface; 39 40package 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 576end System.Mmap; 577