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-2004 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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, 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    --  Instantiation of Styleg, needed  to instantiate Scng
  57
  58    package Style is new Styleg
  59      (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
  60
  61    --  A Scanner is needed to get checksum of a source (procedure
  62    --  Get_File_Checksum).
  63
  64    package Scanner is new Scng
  65      (Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP, Style);
  66
  67    type Header_Num is range 0 .. 1_000;
  68
  69    function Hash (F : File_Name_Type) return Header_Num;
  70    --  Function used to compute hash of ALI file name
  71
  72    package Interfaces is new Simple_HTable (
  73      Header_Num => Header_Num,
  74      Element    => Boolean,
  75      No_Element => False,
  76      Key        => File_Name_Type,
  77      Hash       => Hash,
  78      Equal      => "=");
  79
  80    ---------------------
  81    -- Checksums_Match --
  82    ---------------------
  83
  84    function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is
  85    begin
  86       return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error;
  87    end Checksums_Match;
  88
  89    ---------------
  90    -- Error_Msg --
  91    ---------------
  92
  93    procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
  94       pragma Warnings (Off, Msg);
  95       pragma Warnings (Off, Flag_Location);
  96    begin
  97       null;
  98    end Error_Msg;
  99
 100    -----------------
 101    -- Error_Msg_S --
 102    -----------------
 103
 104    procedure Error_Msg_S (Msg : String) is
 105       pragma Warnings (Off, Msg);
 106    begin
 107       null;
 108    end Error_Msg_S;
 109
 110    ------------------
 111    -- Error_Msg_SC --
 112    ------------------
 113
 114    procedure Error_Msg_SC (Msg : String) is
 115       pragma Warnings (Off, Msg);
 116    begin
 117       null;
 118    end Error_Msg_SC;
 119
 120    ------------------
 121    -- Error_Msg_SP --
 122    ------------------
 123
 124    procedure Error_Msg_SP (Msg : String) is
 125       pragma Warnings (Off, Msg);
 126    begin
 127       null;
 128    end Error_Msg_SP;
 129
 130    -----------------------
 131    -- Get_File_Checksum --
 132    -----------------------
 133
 134    function Get_File_Checksum (Fname : Name_Id) return Word is
 135       Full_Name    : Name_Id;
 136       Source_Index : Source_File_Index;
 137    begin
 138       Full_Name := Find_File (Fname, Osint.Source);
 139
 140       --  If we cannot find the file, then return an impossible checksum,
 141       --  impossible becaues checksums have the high order bit zero, so
 142       --  that checksums do not match.
 143
 144       if Full_Name = No_File then
 145          return Checksum_Error;
 146       end if;
 147
 148       Source_Index := Sinput.C.Load_File (Get_Name_String (Full_Name));
 149
 150       if Source_Index = No_Source_File then
 151          return Checksum_Error;
 152       end if;
 153
 154       Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
 155
 156       --  Make sure that the project language reserved words are not
 157       --  recognized as reserved words, but as identifiers. The byte info for
 158       --  those names have been set if we are in gnatmake.
 159
 160       Set_Name_Table_Byte (Name_Project,  0);
 161       Set_Name_Table_Byte (Name_Extends,  0);
 162       Set_Name_Table_Byte (Name_External, 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_ALI --
 214    --------------
 215
 216    procedure Read_ALI (Id : ALI_Id) is
 217       Afile  : File_Name_Type;
 218       Text   : Text_Buffer_Ptr;
 219       Idread : ALI_Id;
 220
 221    begin
 222       --  Process all dependent units
 223
 224       for U in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop
 225          for
 226            W in Units.Table (U).First_With .. Units.Table (U).Last_With
 227          loop
 228             Afile := Withs.Table (W).Afile;
 229
 230             --  Only process if not a generic (Afile /= No_File) and if
 231             --  file has not been processed already.
 232
 233             if Afile /= No_File
 234               and then Get_Name_Table_Info (Afile) = 0
 235             then
 236                Text := Read_Library_Info (Afile);
 237
 238                --  Return with an error if source cannot be found and if this
 239                --  is not a library generic (now we can, but does not have to
 240                --  compile library generics)
 241
 242                if Text = null then
 243                   if Generic_Separately_Compiled (Withs.Table (W).Sfile) then
 244                      Error_Msg_Name_1 := Afile;
 245                      Error_Msg_Name_2 := Withs.Table (W).Sfile;
 246                      Error_Msg ("% not found, % must be compiled");
 247                      Set_Name_Table_Info (Afile, Int (No_Unit_Id));
 248                      return;
 249
 250                   else
 251                      goto Skip_Library_Generics;
 252                   end if;
 253                end if;
 254
 255                --  Enter in ALIs table
 256
 257                Idread :=
 258                  Scan_ALI
 259                    (F         => Afile,
 260                     T         => Text,
 261                     Ignore_ED => Force_RM_Elaboration_Order,
 262                     Err       => False);
 263
 264                Free (Text);
 265
 266                if ALIs.Table (Idread).Compile_Errors then
 267                   Error_Msg_Name_1 := Withs.Table (W).Sfile;
 268                   Error_Msg ("% had errors, must be fixed, and recompiled");
 269                   Set_Name_Table_Info (Afile, Int (No_Unit_Id));
 270
 271                elsif ALIs.Table (Idread).No_Object then
 272                   Error_Msg_Name_1 := Withs.Table (W).Sfile;
 273                   Error_Msg ("% must be recompiled");
 274                   Set_Name_Table_Info (Afile, Int (No_Unit_Id));
 275                end if;
 276
 277                --  If the Unit is an Interface to a Stand-Alone Library,
 278                --  set the Interface flag in the Withs table, so that its
 279                --  dependant are not considered for elaboration order.
 280
 281                if ALIs.Table (Idread).Interface then
 282                   Withs.Table (W).Interface := True;
 283                   Interface_Library_Unit := True;
 284
 285                   --  Set the entry in the Interfaces hash table, so that other
 286                   --  units that import this unit will set the flag in their
 287                   --  entry in the Withs table.
 288
 289                   Interfaces.Set (Afile, True);
 290
 291                else
 292                   --  Otherwise, recurse to get new dependents
 293
 294                   Read_ALI (Idread);
 295                end if;
 296
 297                <<Skip_Library_Generics>> null;
 298
 299             --  If the ALI file has already been processed and is an interface,
 300             --  set the flag in the entry of the Withs table.
 301
 302             elsif Interface_Library_Unit and then Interfaces.Get (Afile) then
 303                Withs.Table (W).Interface := True;
 304             end if;
 305          end loop;
 306       end loop;
 307    end Read_ALI;
 308
 309    ----------------------
 310    -- Set_Source_Table --
 311    ----------------------
 312
 313    procedure Set_Source_Table (A : ALI_Id) is
 314       F     : File_Name_Type;
 315       S     : Source_Id;
 316       Stamp : Time_Stamp_Type;
 317
 318    begin
 319       Sdep_Loop : for D in
 320         ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
 321       loop
 322          F := Sdep.Table (D).Sfile;
 323
 324          if F /= No_Name then
 325
 326             --  If this is the first time we are seeing this source file,
 327             --  then make a new entry in the source table.
 328
 329             if Get_Name_Table_Info (F) = 0 then
 330                Source.Increment_Last;
 331                S := Source.Last;
 332                Set_Name_Table_Info (F, Int (S));
 333                Source.Table (S).Sfile := F;
 334                Source.Table (S).All_Timestamps_Match := True;
 335
 336                --  Initialize checksum fields
 337
 338                Source.Table (S).Checksum := Sdep.Table (D).Checksum;
 339                Source.Table (S).All_Checksums_Match := True;
 340
 341                --  In check source files mode, try to get time stamp from file
 342
 343                if Opt.Check_Source_Files then
 344                   Stamp := Source_File_Stamp (F);
 345
 346                   --  If we got the stamp, then set the stamp in the source
 347                   --  table entry and mark it as set from the source so that
 348                   --  it does not get subsequently changed.
 349
 350                   if Stamp (Stamp'First) /= ' ' then
 351                      Source.Table (S).Stamp := Stamp;
 352                      Source.Table (S).Source_Found := True;
 353
 354                   --  If we could not find the file, then the stamp is set
 355                   --  from the dependency table entry (to be possibly reset
 356                   --  if we find a later stamp in subsequent processing)
 357
 358                   else
 359                      Source.Table (S).Stamp := Sdep.Table (D).Stamp;
 360                      Source.Table (S).Source_Found := False;
 361
 362                      --  In All_Sources mode, flag error of file not found
 363
 364                      if Opt.All_Sources then
 365                         Error_Msg_Name_1 := F;
 366                         Error_Msg ("cannot locate %");
 367                      end if;
 368                   end if;
 369
 370                --  First time for this source file, but Check_Source_Files
 371                --  is off, so simply initialize the stamp from the Sdep entry
 372
 373                else
 374                   Source.Table (S).Source_Found := False;
 375                   Source.Table (S).Stamp := Sdep.Table (D).Stamp;
 376                end if;
 377
 378             --  Here if this is not the first time for this source file,
 379             --  so that the source table entry is already constructed.
 380
 381             else
 382                S := Source_Id (Get_Name_Table_Info (F));
 383
 384                --  Update checksum flag
 385
 386                if not Checksums_Match
 387                         (Sdep.Table (D).Checksum, Source.Table (S).Checksum)
 388                then
 389                   Source.Table (S).All_Checksums_Match := False;
 390                end if;
 391
 392                --  Check for time stamp mismatch
 393
 394                if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then
 395                   Source.Table (S).All_Timestamps_Match := False;
 396
 397                   --  When we have a time stamp mismatch, we go look for the
 398                   --  source file even if Check_Source_Files is false, since
 399                   --  if we find it, then we can use it to resolve which of the
 400                   --  two timestamps in the ALI files is likely to be correct.
 401
 402                   if not Check_Source_Files then
 403                      Stamp := Source_File_Stamp (F);
 404
 405                      if Stamp (Stamp'First) /= ' ' then
 406                         Source.Table (S).Stamp := Stamp;
 407                         Source.Table (S).Source_Found := True;
 408                      end if;
 409                   end if;
 410
 411                   --  If the stamp in the source table entry was set from the
 412                   --  source file, then we do not change it (the stamp in the
 413                   --  source file is always taken as the "right" one).
 414
 415                   if Source.Table (S).Source_Found then
 416                      null;
 417
 418                   --  Otherwise, we have no source file available, so we guess
 419                   --  that the later of the two timestamps is the right one.
 420                   --  Note that this guess only affects which error messages
 421                   --  are issued later on, not correct functionality.
 422
 423                   else
 424                      if Sdep.Table (D).Stamp > Source.Table (S).Stamp then
 425                         Source.Table (S).Stamp := Sdep.Table (D).Stamp;
 426                      end if;
 427                   end if;
 428                end if;
 429             end if;
 430
 431             --  Set the checksum value in the source table
 432
 433             S := Source_Id (Get_Name_Table_Info (F));
 434             Source.Table (S).Checksum := Sdep.Table (D).Checksum;
 435          end if;
 436
 437       end loop Sdep_Loop;
 438    end Set_Source_Table;
 439
 440    ----------------------
 441    -- Set_Source_Table --
 442    ----------------------
 443
 444    procedure Set_Source_Table is
 445    begin
 446       for A in ALIs.First .. ALIs.Last loop
 447          Set_Source_Table (A);
 448       end loop;
 449    end Set_Source_Table;
 450
 451    -------------------------
 452    -- Time_Stamp_Mismatch --
 453    -------------------------
 454
 455    function Time_Stamp_Mismatch
 456      (A         : ALI_Id;
 457       Read_Only : Boolean := False)
 458       return      File_Name_Type
 459    is
 460       Src : Source_Id;
 461       --  Source file Id for the current Sdep entry
 462
 463    begin
 464       for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
 465          Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
 466
 467          if Opt.Minimal_Recompilation
 468            and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
 469          then
 470             --  If minimal recompilation is in action, replace the stamp
 471             --  of the source file in the table if checksums match.
 472
 473             --  ??? It is probably worth updating the ALI file with a new
 474             --  field to avoid recomputing it each time.
 475
 476             if Checksums_Match
 477                  (Get_File_Checksum (Sdep.Table (D).Sfile),
 478                   Source.Table (Src).Checksum)
 479             then
 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 -t debug flag set, output time stamp found/expected
 490
 491                if Source.Table (Src).Source_Found and 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;