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 --                                                                          --
  10 --          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 with Binderr; use Binderr;
  29 with Namet;   use Namet;
  30 with Opt;     use Opt;
  31 with Osint;   use Osint;
  32
  33 with System.CRC32;
  34 with System.Memory;
  35 with System.Address_To_Access_Conversions;
  36
  37 package body ALI.Util is
  38
  39    -----------------------
  40    -- Local Subprograms --
  41    -----------------------
  42
  43    procedure Accumulate_Checksum (C : Character; Csum : in out Word);
  44    pragma Inline (Accumulate_Checksum);
  45    --  This routine accumulates the checksum given character C. During the
  46    --  scanning of a source file, this routine is called with every character
  47    --  in the source, excluding blanks, and all control characters (except
  48    --  that ESC is included in the checksum). Upper case letters not in string
  49    --  literals are folded by the caller. See Sinput spec for the documentation
  50    --  of the checksum algorithm. Note: checksum values are only used if we
  51    --  generate code, so it is not necessary to worry about making the right
  52    --  sequence of calls in any error situation.
  53
  54    procedure Initialize_Checksum (Csum : out Word);
  55    --  Sets initial value of Csum before any calls to Accumulate_Checksum
  56
  57    -------------------------
  58    -- Accumulate_Checksum --
  59    -------------------------
  60
  61    procedure Accumulate_Checksum (C : Character; Csum : in out Word) is
  62    begin
  63       System.CRC32.Update (System.CRC32.CRC32 (Csum), C);
  64    end Accumulate_Checksum;
  65
  66    ---------------------
  67    -- Checksums_Match --
  68    ---------------------
  69
  70    function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is
  71    begin
  72       return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error;
  73    end Checksums_Match;
  74
  75    -----------------------
  76    -- Get_File_Checksum --
  77    -----------------------
  78
  79    function Get_File_Checksum (Fname : Name_Id) return Word is
  80       Src  : Source_Buffer_Ptr;
  81       Hi   : Source_Ptr;
  82       Csum : Word;
  83       Ptr  : Source_Ptr;
  84
  85       Bad : exception;
  86       --  Raised if file not found, or file format error
  87
  88       use ASCII;
  89       --  Make control characters visible
  90
  91       procedure Free_Source;
  92       --  Free source file buffer
  93
  94       procedure Free_Source is
  95
  96          package SB is
  97             new System.Address_To_Access_Conversions (Big_Source_Buffer);
  98
  99       begin
 100          System.Memory.Free (SB.To_Address (SB.Object_Pointer (Src)));
 101       end Free_Source;
 102
 103    --  Start of processing for Get_File_Checksum
 104
 105    begin
 106       Read_Source_File (Fname, 0, Hi, Src);
 107
 108       --  If we cannot find the file, then return an impossible checksum,
 109       --  impossible becaues checksums have the high order bit zero, so
 110       --  that checksums do not match.
 111
 112       if Src = null then
 113          raise Bad;
 114       end if;
 115
 116       Initialize_Checksum (Csum);
 117       Ptr := 0;
 118
 119       loop
 120          case Src (Ptr) is
 121
 122             --  Spaces and formatting information are ignored in checksum
 123
 124             when ' ' | CR | LF | VT | FF | HT =>
 125                Ptr := Ptr + 1;
 126
 127             --  EOF is ignored unless it is the last character
 128
 129             when EOF =>
 130                if Ptr = Hi then
 131                   Free_Source;
 132                   return Csum;
 133                else
 134                   Ptr := Ptr + 1;
 135                end if;
 136
 137             --  Non-blank characters that are included in the checksum
 138
 139             when '#' | '&' | '*' | ':' | '(' | ',' | '.' | '=' | '>' |
 140                  '<' | ')' | '/' | ';' | '|' | '!' | '+' | '_' |
 141                  '0' .. '9' | 'a' .. 'z'
 142             =>
 143                Accumulate_Checksum (Src (Ptr), Csum);
 144                Ptr := Ptr + 1;
 145
 146             --  Upper case letters, fold to lower case
 147
 148             when 'A' .. 'Z' =>
 149                Accumulate_Checksum
 150                  (Character'Val (Character'Pos (Src (Ptr)) + 32), Csum);
 151                Ptr := Ptr + 1;
 152
 153             --  Left bracket, really should do wide character thing here,
 154             --  but for now, don't bother.
 155
 156             when '[' =>
 157                raise Bad;
 158
 159             --  Minus, could be comment
 160
 161             when '-' =>
 162                if Src (Ptr + 1) = '-' then
 163                   Ptr := Ptr + 2;
 164
 165                   while Src (Ptr) >= ' ' or else Src (Ptr) = HT loop
 166                      Ptr := Ptr + 1;
 167                   end loop;
 168
 169                else
 170                   Accumulate_Checksum ('-', Csum);
 171                   Ptr := Ptr + 1;
 172                end if;
 173
 174             --  String delimited by double quote
 175
 176             when '"' =>
 177                Accumulate_Checksum ('"', Csum);
 178
 179                loop
 180                   Ptr := Ptr + 1;
 181                   exit when Src (Ptr) = '"';
 182
 183                   if Src (Ptr) < ' ' then
 184                      raise Bad;
 185                   end if;
 186
 187                   Accumulate_Checksum (Src (Ptr), Csum);
 188                end loop;
 189
 190                Accumulate_Checksum ('"', Csum);
 191                Ptr := Ptr + 1;
 192
 193             --  String delimited by percent
 194
 195             when '%' =>
 196                Accumulate_Checksum ('%', Csum);
 197
 198                loop
 199                   Ptr := Ptr + 1;
 200                   exit when Src (Ptr) = '%';
 201
 202                   if Src (Ptr) < ' ' then
 203                      raise Bad;
 204                   end if;
 205
 206                   Accumulate_Checksum (Src (Ptr), Csum);
 207                end loop;
 208
 209                Accumulate_Checksum ('%', Csum);
 210                Ptr := Ptr + 1;
 211
 212             --  Quote, could be character constant
 213
 214             when ''' =>
 215                Accumulate_Checksum (''', Csum);
 216
 217                if Src (Ptr + 2) = ''' then
 218                   Accumulate_Checksum (Src (Ptr + 1), Csum);
 219                   Accumulate_Checksum (''', Csum);
 220                   Ptr := Ptr + 3;
 221
 222                --  Otherwise assume attribute char. We should deal with wide
 223                --  character cases here, but that's hard, so forget it.
 224
 225                else
 226                   Ptr := Ptr + 1;
 227                end if;
 228
 229             --  Upper half character, more to be done here, we should worry
 230             --  about folding Latin-1, folding other character sets, and
 231             --  dealing with the nasty case of upper half wide encoding.
 232
 233             when Upper_Half_Character =>
 234                Accumulate_Checksum (Src (Ptr), Csum);
 235                Ptr := Ptr + 1;
 236
 237             --  Escape character, we should do the wide character thing here,
 238             --  but for now, do not bother.
 239
 240             when ESC =>
 241                raise Bad;
 242
 243             --  Invalid control characters
 244
 245             when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS  | SO  |
 246                  SI  | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
 247                  EM  | FS  | GS  | RS  | US  | DEL
 248             =>
 249                raise Bad;
 250
 251             --  Invalid graphic characters
 252
 253             when '$' | '?' | '@' | '`' | '\' |
 254                  '^' | '~' | ']' | '{' | '}'
 255             =>
 256                raise Bad;
 257
 258          end case;
 259       end loop;
 260
 261    exception
 262       when Bad =>
 263          Free_Source;
 264          return Checksum_Error;
 265
 266    end Get_File_Checksum;
 267
 268    ---------------------------
 269    -- Initialize_ALI_Source --
 270    ---------------------------
 271
 272    procedure Initialize_ALI_Source is
 273    begin
 274       --  When (re)initializing ALI data structures the ALI user expects to
 275       --  get a fresh set of data structures. Thus we first need to erase the
 276       --  marks put in the name table by the previous set of ALI routine calls.
 277       --  This loop is empty and harmless the first time in.
 278
 279       for J in Source.First .. Source.Last loop
 280          Set_Name_Table_Info (Source.Table (J).Sfile, 0);
 281          Source.Table (J).Source_Found := False;
 282       end loop;
 283
 284       Source.Init;
 285    end Initialize_ALI_Source;
 286
 287    -------------------------
 288    -- Initialize_Checksum --
 289    -------------------------
 290
 291    procedure Initialize_Checksum (Csum : out Word) is
 292    begin
 293       System.CRC32.Initialize (System.CRC32.CRC32 (Csum));
 294    end Initialize_Checksum;
 295
 296    --------------
 297    -- Read_ALI --
 298    --------------
 299
 300    procedure Read_ALI (Id : ALI_Id) is
 301       Afile  : File_Name_Type;
 302       Text   : Text_Buffer_Ptr;
 303       Idread : ALI_Id;
 304
 305    begin
 306       for I in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop
 307          for J in Units.Table (I).First_With .. Units.Table (I).Last_With loop
 308
 309             Afile := Withs.Table (J).Afile;
 310
 311             --  Only process if not a generic (Afile /= No_File) and if
 312             --  file has not been processed already.
 313
 314             if Afile /= No_File and then Get_Name_Table_Info (Afile) = 0 then
 315
 316                Text := Read_Library_Info (Afile);
 317
 318                if Text = null then
 319                   Error_Msg_Name_1 := Afile;
 320                   Error_Msg_Name_2 := Withs.Table (J).Sfile;
 321                   Error_Msg ("% not found, % must be compiled");
 322                   Set_Name_Table_Info (Afile, Int (No_Unit_Id));
 323                   return;
 324                end if;
 325
 326                Idread :=
 327                  Scan_ALI
 328                    (F         => Afile,
 329                     T         => Text,
 330                     Ignore_ED => Force_RM_Elaboration_Order,
 331                     Err       => False);
 332
 333                Free (Text);
 334
 335                if ALIs.Table (Idread).Compile_Errors then
 336                   Error_Msg_Name_1 := Withs.Table (J).Sfile;
 337                   Error_Msg ("% had errors, must be fixed, and recompiled");
 338                   Set_Name_Table_Info (Afile, Int (No_Unit_Id));
 339
 340                elsif ALIs.Table (Idread).No_Object then
 341                   Error_Msg_Name_1 := Withs.Table (J).Sfile;
 342                   Error_Msg ("% must be recompiled");
 343                   Set_Name_Table_Info (Afile, Int (No_Unit_Id));
 344                end if;
 345
 346                --  Recurse to get new dependents
 347
 348                Read_ALI (Idread);
 349             end if;
 350          end loop;
 351       end loop;
 352
 353    end Read_ALI;
 354
 355    ----------------------
 356    -- Set_Source_Table --
 357    ----------------------
 358
 359    procedure Set_Source_Table (A : ALI_Id) is
 360       F     : File_Name_Type;
 361       S     : Source_Id;
 362       Stamp : Time_Stamp_Type;
 363
 364    begin
 365       Sdep_Loop : for D in
 366         ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
 367       loop
 368          F := Sdep.Table (D).Sfile;
 369
 370          --  If this is the first time we are seeing this source file,
 371          --  then make a new entry in the source table.
 372
 373          if Get_Name_Table_Info (F) = 0 then
 374             Source.Increment_Last;
 375             S := Source.Last;
 376             Set_Name_Table_Info (F, Int (S));
 377             Source.Table (S).Sfile := F;
 378             Source.Table (S).All_Timestamps_Match := True;
 379
 380             --  Initialize checksum fields
 381
 382             Source.Table (S).Checksum := Sdep.Table (D).Checksum;
 383             Source.Table (S).All_Checksums_Match := True;
 384
 385             --  In check source files mode, try to get time stamp from file
 386
 387             if Opt.Check_Source_Files then
 388                Stamp := Source_File_Stamp (F);
 389
 390                --  If we got the stamp, then set the stamp in the source
 391                --  table entry and mark it as set from the source so that
 392                --  it does not get subsequently changed.
 393
 394                if Stamp (Stamp'First) /= ' ' then
 395                   Source.Table (S).Stamp := Stamp;
 396                   Source.Table (S).Source_Found := True;
 397
 398                --  If we could not find the file, then the stamp is set
 399                --  from the dependency table entry (to be possibly reset
 400                --  if we find a later stamp in subsequent processing)
 401
 402                else
 403                   Source.Table (S).Stamp := Sdep.Table (D).Stamp;
 404                   Source.Table (S).Source_Found := False;
 405
 406                   --  In All_Sources mode, flag error of file not found
 407
 408                   if Opt.All_Sources then
 409                      Error_Msg_Name_1 := F;
 410                      Error_Msg ("cannot locate %");
 411                   end if;
 412                end if;
 413
 414             --  First time for this source file, but Check_Source_Files
 415             --  is off, so simply initialize the stamp from the Sdep entry
 416
 417             else
 418                Source.Table (S).Source_Found := False;
 419                Source.Table (S).Stamp := Sdep.Table (D).Stamp;
 420             end if;
 421
 422          --  Here if this is not the first time for this source file,
 423          --  so that the source table entry is already constructed.
 424
 425          else
 426             S := Source_Id (Get_Name_Table_Info (F));
 427
 428             --  Update checksum flag
 429
 430             if not Checksums_Match
 431                      (Sdep.Table (D).Checksum, Source.Table (S).Checksum)
 432             then
 433                Source.Table (S).All_Checksums_Match := False;
 434             end if;
 435
 436             --  Check for time stamp mismatch
 437
 438             if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then
 439                Source.Table (S).All_Timestamps_Match := False;
 440
 441                --  When we have a time stamp mismatch, we go look for the
 442                --  source file even if Check_Source_Files is false, since
 443                --  if we find it, then we can use it to resolve which of the
 444                --  two timestamps in the ALI files is likely to be correct.
 445
 446                if not Check_Source_Files then
 447                   Stamp := Source_File_Stamp (F);
 448
 449                   if Stamp (Stamp'First) /= ' ' then
 450                      Source.Table (S).Stamp := Stamp;
 451                      Source.Table (S).Source_Found := True;
 452                   end if;
 453                end if;
 454
 455                --  If the stamp in the source table entry was set from the
 456                --  source file, then we do not change it (the stamp in the
 457                --  source file is always taken as the "right" one).
 458
 459                if Source.Table (S).Source_Found then
 460                   null;
 461
 462                --  Otherwise, we have no source file available, so we guess
 463                --  that the later of the two timestamps is the right one.
 464                --  Note that this guess only affects which error messages
 465                --  are issued later on, not correct functionality.
 466
 467                else
 468                   if Sdep.Table (D).Stamp > Source.Table (S).Stamp then
 469                      Source.Table (S).Stamp := Sdep.Table (D).Stamp;
 470                   end if;
 471                end if;
 472             end if;
 473          end if;
 474
 475          --  Set the checksum value in the source table
 476
 477          S := Source_Id (Get_Name_Table_Info (F));
 478          Source.Table (S).Checksum := Sdep.Table (D).Checksum;
 479
 480       end loop Sdep_Loop;
 481
 482    end Set_Source_Table;
 483
 484    ----------------------
 485    -- Set_Source_Table --
 486    ----------------------
 487
 488    procedure Set_Source_Table is
 489    begin
 490       for A in ALIs.First .. ALIs.Last loop
 491          Set_Source_Table (A);
 492       end loop;
 493
 494    end Set_Source_Table;
 495
 496    -------------------------
 497    -- Time_Stamp_Mismatch --
 498    -------------------------
 499
 500    function Time_Stamp_Mismatch (A : ALI_Id) return File_Name_Type is
 501       Src : Source_Id;
 502       --  Source file Id for the current Sdep entry
 503
 504    begin
 505       for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
 506          Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
 507
 508          if Opt.Minimal_Recompilation
 509            and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
 510          then
 511
 512             --  If minimal recompilation is in action, replace the stamp
 513             --  of the source file in the table if checksums match.
 514
 515             --  ??? It is probably worth updating the ALI file with a new
 516             --  field to avoid recomputing it each time.
 517
 518             if Checksums_Match
 519                  (Get_File_Checksum (Sdep.Table (D).Sfile),
 520                   Source.Table (Src).Checksum)
 521             then
 522                Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
 523             end if;
 524
 525          end if;
 526
 527          if not Source.Table (Src).Source_Found
 528            or else Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
 529          then
 530             return Source.Table (Src).Sfile;
 531          end if;
 532       end loop;
 533
 534       return No_File;
 535
 536    end Time_Stamp_Mismatch;
 537
 538 end ALI.Util;