gcc/ada/ali-util.adb

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