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