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