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