1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- A L I . U T I L -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Debug; use Debug; 27with Binderr; use Binderr; 28with Opt; use Opt; 29with Output; use Output; 30with Osint; use Osint; 31with Scans; use Scans; 32with Scng; 33with Sinput.C; 34with Snames; use Snames; 35with Stringt; 36with Styleg; 37 38with System.OS_Lib; use System.OS_Lib; 39 40package body ALI.Util is 41 42 -- Empty procedures needed to instantiate Scng. Error procedures are 43 -- empty, because we don't want to report any errors when computing 44 -- a source checksum. 45 46 procedure Post_Scan; 47 48 procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr); 49 50 procedure Error_Msg_S (Msg : String); 51 52 procedure Error_Msg_SC (Msg : String); 53 54 procedure Error_Msg_SP (Msg : String); 55 56 -- Instantiation of Styleg, needed to instantiate Scng 57 58 package Style is new Styleg 59 (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP); 60 61 -- A Scanner is needed to get checksum of a source (procedure 62 -- Get_File_Checksum). 63 64 package Scanner is new Scng 65 (Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP, Style); 66 67 type Header_Num is range 0 .. 1_000; 68 69 function Hash (F : File_Name_Type) return Header_Num; 70 -- Function used to compute hash of ALI file name 71 72 package Interfaces is new Simple_HTable ( 73 Header_Num => Header_Num, 74 Element => Boolean, 75 No_Element => False, 76 Key => File_Name_Type, 77 Hash => Hash, 78 Equal => "="); 79 80 --------------------- 81 -- Checksums_Match -- 82 --------------------- 83 84 function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is 85 begin 86 return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error; 87 end Checksums_Match; 88 89 --------------- 90 -- Error_Msg -- 91 --------------- 92 93 procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is 94 pragma Warnings (Off, Msg); 95 pragma Warnings (Off, Flag_Location); 96 begin 97 null; 98 end Error_Msg; 99 100 ----------------- 101 -- Error_Msg_S -- 102 ----------------- 103 104 procedure Error_Msg_S (Msg : String) is 105 pragma Warnings (Off, Msg); 106 begin 107 null; 108 end Error_Msg_S; 109 110 ------------------ 111 -- Error_Msg_SC -- 112 ------------------ 113 114 procedure Error_Msg_SC (Msg : String) is 115 pragma Warnings (Off, Msg); 116 begin 117 null; 118 end Error_Msg_SC; 119 120 ------------------ 121 -- Error_Msg_SP -- 122 ------------------ 123 124 procedure Error_Msg_SP (Msg : String) is 125 pragma Warnings (Off, Msg); 126 begin 127 null; 128 end Error_Msg_SP; 129 130 ----------------------- 131 -- Get_File_Checksum -- 132 ----------------------- 133 134 function Get_File_Checksum (Fname : File_Name_Type) return Word is 135 Full_Name : File_Name_Type; 136 Source_Index : Source_File_Index; 137 138 begin 139 Full_Name := Find_File (Fname, Osint.Source); 140 141 -- If we cannot find the file, then return an impossible checksum, 142 -- impossible because checksums have the high order bit zero, so 143 -- that checksums do not match. 144 145 if Full_Name = No_File then 146 return Checksum_Error; 147 end if; 148 149 Source_Index := Sinput.C.Load_File (Get_Name_String (Full_Name)); 150 151 if Source_Index <= No_Source_File then 152 return Checksum_Error; 153 end if; 154 155 Scanner.Initialize_Scanner (Source_Index); 156 157 -- Make sure that the project language reserved words are not 158 -- recognized as reserved words, but as identifiers. The byte info for 159 -- those names have been set if we are in gnatmake. 160 161 Set_Name_Table_Byte (Name_Project, 0); 162 Set_Name_Table_Byte (Name_Extends, 0); 163 Set_Name_Table_Byte (Name_External, 0); 164 Set_Name_Table_Byte (Name_External_As_List, 0); 165 166 -- Scan the complete file to compute its checksum 167 168 loop 169 Scanner.Scan; 170 exit when Token = Tok_EOF; 171 end loop; 172 173 return Scans.Checksum; 174 end Get_File_Checksum; 175 176 ---------- 177 -- Hash -- 178 ---------- 179 180 function Hash (F : File_Name_Type) return Header_Num is 181 begin 182 return Header_Num (Int (F) rem Header_Num'Range_Length); 183 end Hash; 184 185 --------------------------- 186 -- Initialize_ALI_Source -- 187 --------------------------- 188 189 procedure Initialize_ALI_Source is 190 begin 191 -- When (re)initializing ALI data structures the ALI user expects to 192 -- get a fresh set of data structures. Thus we first need to erase the 193 -- marks put in the name table by the previous set of ALI routine calls. 194 -- This loop is empty and harmless the first time in. 195 196 for J in Source.First .. Source.Last loop 197 Set_Name_Table_Int (Source.Table (J).Sfile, 0); 198 Source.Table (J).Source_Found := False; 199 end loop; 200 201 Source.Init; 202 Interfaces.Reset; 203 end Initialize_ALI_Source; 204 205 --------------- 206 -- Post_Scan -- 207 --------------- 208 209 procedure Post_Scan is 210 begin 211 null; 212 end Post_Scan; 213 214 ---------------------- 215 -- Read_Withed_ALIs -- 216 ---------------------- 217 218 procedure Read_Withed_ALIs 219 (Id : ALI_Id; 220 Ignore_Errors : Boolean := False) 221 is 222 Afile : File_Name_Type; 223 Text : Text_Buffer_Ptr; 224 Idread : ALI_Id; 225 226 begin 227 -- Process all dependent units 228 229 for U in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop 230 for 231 W in Units.Table (U).First_With .. Units.Table (U).Last_With 232 loop 233 Afile := Withs.Table (W).Afile; 234 235 -- Only process if not a generic (Afile /= No_File) and if 236 -- file has not been processed already. 237 238 if Afile /= No_File 239 and then Get_Name_Table_Int (Afile) = 0 240 then 241 Text := Read_Library_Info (Afile); 242 243 -- Unless Ignore_Errors is true, return with an error if source 244 -- cannot be found. We used to skip this check when we did not 245 -- compile library generics separately, but we now always do, 246 -- so there is no special case here anymore. 247 248 if Text = null then 249 250 if not Ignore_Errors then 251 Error_Msg_File_1 := Afile; 252 Error_Msg_File_2 := Withs.Table (W).Sfile; 253 Error_Msg ("{ not found, { must be compiled"); 254 Set_Name_Table_Int (Afile, Int (No_Unit_Id)); 255 return; 256 end if; 257 258 else 259 -- Enter in ALIs table 260 261 Idread := 262 Scan_ALI 263 (F => Afile, 264 T => Text, 265 Ignore_ED => False, 266 Err => False); 267 268 Free (Text); 269 270 if ALIs.Table (Idread).Compile_Errors 271 and then not Ignore_Errors 272 then 273 Error_Msg_File_1 := Withs.Table (W).Sfile; 274 Error_Msg ("{ had errors, must be fixed, and recompiled"); 275 Set_Name_Table_Int (Afile, Int (No_Unit_Id)); 276 277 -- In GNATprove mode, object files are never generated, so 278 -- No_Object=True is not considered an error. 279 280 elsif ALIs.Table (Idread).No_Object 281 and then not GNATprove_Mode 282 and then not Ignore_Errors 283 then 284 Error_Msg_File_1 := Withs.Table (W).Sfile; 285 Error_Msg ("{ must be recompiled"); 286 Set_Name_Table_Int (Afile, Int (No_Unit_Id)); 287 end if; 288 289 -- If the Unit is an Interface to a Stand-Alone Library, 290 -- set the Interface flag in the Withs table, so that its 291 -- dependant are not considered for elaboration order. 292 293 if ALIs.Table (Idread).SAL_Interface then 294 Withs.Table (W).SAL_Interface := True; 295 Interface_Library_Unit := True; 296 297 -- Set the entry in the Interfaces hash table, so that 298 -- other units that import this unit will set the flag 299 -- in their entry in the Withs table. 300 301 Interfaces.Set (Afile, True); 302 303 else 304 -- Otherwise, recurse to get new dependents 305 306 Read_Withed_ALIs (Idread); 307 end if; 308 end if; 309 310 -- If the ALI file has already been processed and is an interface, 311 -- set the flag in the entry of the Withs table. 312 313 elsif Interface_Library_Unit and then Interfaces.Get (Afile) then 314 Withs.Table (W).SAL_Interface := True; 315 end if; 316 end loop; 317 end loop; 318 end Read_Withed_ALIs; 319 320 ---------------------- 321 -- Set_Source_Table -- 322 ---------------------- 323 324 procedure Set_Source_Table (A : ALI_Id) is 325 F : File_Name_Type; 326 S : Source_Id; 327 Stamp : Time_Stamp_Type; 328 329 begin 330 Sdep_Loop : for D in 331 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep 332 loop 333 F := Sdep.Table (D).Sfile; 334 335 if F /= No_File then 336 337 -- If this is the first time we are seeing this source file, 338 -- then make a new entry in the source table. 339 340 if Get_Name_Table_Int (F) = 0 then 341 Source.Increment_Last; 342 S := Source.Last; 343 Set_Name_Table_Int (F, Int (S)); 344 Source.Table (S).Sfile := F; 345 Source.Table (S).All_Timestamps_Match := True; 346 347 -- Initialize checksum fields 348 349 Source.Table (S).Checksum := Sdep.Table (D).Checksum; 350 Source.Table (S).All_Checksums_Match := True; 351 352 -- In check source files mode, try to get time stamp from file 353 354 if Opt.Check_Source_Files then 355 Stamp := Source_File_Stamp (F); 356 357 -- If we got the stamp, then set the stamp in the source 358 -- table entry and mark it as set from the source so that 359 -- it does not get subsequently changed. 360 361 if Stamp (Stamp'First) /= ' ' then 362 Source.Table (S).Stamp := Stamp; 363 Source.Table (S).Source_Found := True; 364 Source.Table (S).Stamp_File := F; 365 366 -- If we could not find the file, then the stamp is set 367 -- from the dependency table entry (to be possibly reset 368 -- if we find a later stamp in subsequent processing) 369 370 else 371 Source.Table (S).Stamp := Sdep.Table (D).Stamp; 372 Source.Table (S).Source_Found := False; 373 Source.Table (S).Stamp_File := ALIs.Table (A).Afile; 374 375 -- In All_Sources mode, flag error of file not found 376 377 if Opt.All_Sources then 378 Error_Msg_File_1 := F; 379 Error_Msg ("cannot locate {"); 380 end if; 381 end if; 382 383 -- First time for this source file, but Check_Source_Files 384 -- is off, so simply initialize the stamp from the Sdep entry 385 386 else 387 Source.Table (S).Stamp := Sdep.Table (D).Stamp; 388 Source.Table (S).Source_Found := False; 389 Source.Table (S).Stamp_File := ALIs.Table (A).Afile; 390 end if; 391 392 -- Here if this is not the first time for this source file, 393 -- so that the source table entry is already constructed. 394 395 else 396 S := Source_Id (Get_Name_Table_Int (F)); 397 398 -- Update checksum flag 399 400 if not Checksums_Match 401 (Sdep.Table (D).Checksum, Source.Table (S).Checksum) 402 then 403 Source.Table (S).All_Checksums_Match := False; 404 end if; 405 406 -- Check for time stamp mismatch 407 408 if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then 409 Source.Table (S).All_Timestamps_Match := False; 410 411 -- When we have a time stamp mismatch, we go look for the 412 -- source file even if Check_Source_Files is false, since 413 -- if we find it, then we can use it to resolve which of the 414 -- two timestamps in the ALI files is likely to be correct. 415 -- We only look in the current directory, because when 416 -- Check_Source_Files is false, other search directories are 417 -- likely to be incorrect. 418 419 if not Check_Source_Files 420 and then Is_Regular_File (Get_Name_String (F)) 421 then 422 Stamp := Source_File_Stamp (F); 423 424 if Stamp (Stamp'First) /= ' ' then 425 Source.Table (S).Stamp := Stamp; 426 Source.Table (S).Source_Found := True; 427 Source.Table (S).Stamp_File := F; 428 end if; 429 end if; 430 431 -- If the stamp in the source table entry was set from the 432 -- source file, then we do not change it (the stamp in the 433 -- source file is always taken as the "right" one). 434 435 if Source.Table (S).Source_Found then 436 null; 437 438 -- Otherwise, we have no source file available, so we guess 439 -- that the later of the two timestamps is the right one. 440 -- Note that this guess only affects which error messages 441 -- are issued later on, not correct functionality. 442 443 else 444 if Sdep.Table (D).Stamp > Source.Table (S).Stamp then 445 Source.Table (S).Stamp := Sdep.Table (D).Stamp; 446 Source.Table (S).Stamp_File := ALIs.Table (A).Afile; 447 end if; 448 end if; 449 end if; 450 end if; 451 452 -- Set the checksum value in the source table 453 454 S := Source_Id (Get_Name_Table_Int (F)); 455 Source.Table (S).Checksum := Sdep.Table (D).Checksum; 456 end if; 457 458 end loop Sdep_Loop; 459 end Set_Source_Table; 460 461 ---------------------- 462 -- Set_Source_Table -- 463 ---------------------- 464 465 procedure Set_Source_Table is 466 begin 467 for A in ALIs.First .. ALIs.Last loop 468 Set_Source_Table (A); 469 end loop; 470 end Set_Source_Table; 471 472 ------------------------- 473 -- Time_Stamp_Mismatch -- 474 ------------------------- 475 476 function Time_Stamp_Mismatch 477 (A : ALI_Id; 478 Read_Only : Boolean := False) return File_Name_Type 479 is 480 Src : Source_Id; 481 -- Source file Id for the current Sdep entry 482 483 begin 484 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop 485 Src := Source_Id (Get_Name_Table_Int (Sdep.Table (D).Sfile)); 486 487 if Opt.Minimal_Recompilation 488 and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp 489 then 490 -- If minimal recompilation is in action, replace the stamp 491 -- of the source file in the table if checksums match. 492 493 -- ??? It is probably worth updating the ALI file with a new 494 -- field to avoid recomputing it each time. In any case we ensure 495 -- that we don't gobble up string table space by doing a mark 496 -- release around this computation. 497 498 Stringt.Mark; 499 500 if Checksums_Match 501 (Get_File_Checksum (Sdep.Table (D).Sfile), 502 Source.Table (Src).Checksum) 503 then 504 if Verbose_Mode then 505 Write_Str (" "); 506 Write_Str (Get_Name_String (Sdep.Table (D).Sfile)); 507 Write_Str (": up to date, different timestamps " & 508 "but same checksum"); 509 Write_Eol; 510 end if; 511 512 Sdep.Table (D).Stamp := Source.Table (Src).Stamp; 513 end if; 514 515 Stringt.Release; 516 end if; 517 518 if (not Read_Only) or else Source.Table (Src).Source_Found then 519 if not Source.Table (Src).Source_Found 520 or else Sdep.Table (D).Stamp /= Source.Table (Src).Stamp 521 then 522 -- If -dt debug flag set, output time stamp found/expected 523 524 if Source.Table (Src).Source_Found and then Debug_Flag_T then 525 Write_Str ("Source: """); 526 Get_Name_String (Sdep.Table (D).Sfile); 527 Write_Str (Name_Buffer (1 .. Name_Len)); 528 Write_Line (""""); 529 530 Write_Str (" time stamp expected: "); 531 Write_Line (String (Sdep.Table (D).Stamp)); 532 533 Write_Str (" time stamp found: "); 534 Write_Line (String (Source.Table (Src).Stamp)); 535 end if; 536 537 -- Return the source file 538 539 return Source.Table (Src).Sfile; 540 end if; 541 end if; 542 end loop; 543 544 return No_File; 545 end Time_Stamp_Mismatch; 546 547end ALI.Util; 548