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