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-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
  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 Stringt;
  36 with Styleg;
  37
  38 package 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
 531 end ALI.Util;