[thirdparty/gcc.git] / gcc / ada / ali-util.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             A L I . U T I L                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Debug;   use Debug;
with Binderr; use Binderr;
with Lib;     use Lib;
with Namet;   use Namet;
with Opt;     use Opt;
with Output;  use Output;
with Osint;   use Osint;

with System.CRC32;
with System.Memory;

package body ALI.Util is

   type Header_Num is range 0 .. 1_000;

   function Hash (F : File_Name_Type) return Header_Num;
   --  Function used to compute hash of ALI file name

   package Interfaces is new Simple_HTable (
     Header_Num => Header_Num,
     Element    => Boolean,
     No_Element => False,
     Key        => File_Name_Type,
     Hash       => Hash,
     Equal      => "=");

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Accumulate_Checksum (C : Character; Csum : in out Word);
   pragma Inline (Accumulate_Checksum);
   --  This routine accumulates the checksum given character C. During the
   --  scanning of a source file, this routine is called with every character
   --  in the source, excluding blanks, and all control characters (except
   --  that ESC is included in the checksum). Upper case letters not in string
   --  literals are folded by the caller. See Sinput spec for the documentation
   --  of the checksum algorithm. Note: checksum values are only used if we
   --  generate code, so it is not necessary to worry about making the right
   --  sequence of calls in any error situation.

   procedure Initialize_Checksum (Csum : out Word);
   --  Sets initial value of Csum before any calls to Accumulate_Checksum

   -------------------------
   -- Accumulate_Checksum --
   -------------------------

   procedure Accumulate_Checksum (C : Character; Csum : in out Word) is
   begin
      System.CRC32.Update (System.CRC32.CRC32 (Csum), C);
   end Accumulate_Checksum;

   ---------------------
   -- Checksums_Match --
   ---------------------

   function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is
   begin
      return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error;
   end Checksums_Match;

   -----------------------
   -- Get_File_Checksum --
   -----------------------

   function Get_File_Checksum (Fname : Name_Id) return Word is
      Src  : Source_Buffer_Ptr;
      Hi   : Source_Ptr;
      Csum : Word;
      Ptr  : Source_Ptr;

      Bad : exception;
      --  Raised if file not found, or file format error

      use ASCII;
      --  Make control characters visible

   begin
      Read_Source_File (Fname, 0, Hi, Src);

      --  If we cannot find the file, then return an impossible checksum,
      --  impossible becaues checksums have the high order bit zero, so
      --  that checksums do not match.

      if Src = null then
         raise Bad;
      end if;

      Initialize_Checksum (Csum);
      Ptr := 0;

      loop
         case Src (Ptr) is

            --  Spaces and formatting information are ignored in checksum

            when ' ' | CR | LF | VT | FF | HT =>
               Ptr := Ptr + 1;

            --  EOF is ignored unless it is the last character

            when EOF =>
               if Ptr = Hi then
                  System.Memory.Free (Src.all'Address);
                  return Csum;
               else
                  Ptr := Ptr + 1;
               end if;

            --  Non-blank characters that are included in the checksum

            when '#' | '&' | '*' | ':' | '(' | ',' | '.' | '=' | '>' |
                 '<' | ')' | '/' | ';' | '|' | '!' | '+' | '_' |
                 '0' .. '9' | 'a' .. 'z'
            =>
               Accumulate_Checksum (Src (Ptr), Csum);
               Ptr := Ptr + 1;

            --  Upper case letters, fold to lower case

            when 'A' .. 'Z' =>
               Accumulate_Checksum
                 (Character'Val (Character'Pos (Src (Ptr)) + 32), Csum);
               Ptr := Ptr + 1;

            --  Left bracket, really should do wide character thing here,
            --  but for now, don't bother.

            when '[' =>
               raise Bad;

            --  Minus, could be comment

            when '-' =>
               if Src (Ptr + 1) = '-' then
                  Ptr := Ptr + 2;

                  while Src (Ptr) >= ' ' or else Src (Ptr) = HT loop
                     Ptr := Ptr + 1;
                  end loop;

               else
                  Accumulate_Checksum ('-', Csum);
                  Ptr := Ptr + 1;
               end if;

            --  String delimited by double quote

            when '"' =>
               Accumulate_Checksum ('"', Csum);

               loop
                  Ptr := Ptr + 1;
                  exit when Src (Ptr) = '"';

                  if Src (Ptr) < ' ' then
                     raise Bad;
                  end if;

                  Accumulate_Checksum (Src (Ptr), Csum);
               end loop;

               Accumulate_Checksum ('"', Csum);
               Ptr := Ptr + 1;

            --  String delimited by percent

            when '%' =>
               Accumulate_Checksum ('%', Csum);

               loop
                  Ptr := Ptr + 1;
                  exit when Src (Ptr) = '%';

                  if Src (Ptr) < ' ' then
                     raise Bad;
                  end if;

                  Accumulate_Checksum (Src (Ptr), Csum);
               end loop;

               Accumulate_Checksum ('%', Csum);
               Ptr := Ptr + 1;

            --  Quote, could be character constant

            when ''' =>
               Accumulate_Checksum (''', Csum);

               if Src (Ptr + 2) = ''' then
                  Accumulate_Checksum (Src (Ptr + 1), Csum);
                  Accumulate_Checksum (''', Csum);
                  Ptr := Ptr + 3;

               --  Otherwise assume attribute char. We should deal with wide
               --  character cases here, but that's hard, so forget it.

               else
                  Ptr := Ptr + 1;
               end if;

            --  Upper half character, more to be done here, we should worry
            --  about folding Latin-1, folding other character sets, and
            --  dealing with the nasty case of upper half wide encoding.

            when Upper_Half_Character =>
               Accumulate_Checksum (Src (Ptr), Csum);
               Ptr := Ptr + 1;

            --  Escape character, we should do the wide character thing here,
            --  but for now, do not bother.

            when ESC =>
               raise Bad;

            --  Invalid control characters

            when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS  | SO  |
                 SI  | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
                 EM  | FS  | GS  | RS  | US  | DEL
            =>
               raise Bad;

            --  Invalid graphic characters

            when '$' | '?' | '@' | '`' | '\' |
                 '^' | '~' | ']' | '{' | '}'
            =>
               raise Bad;

         end case;
      end loop;

   exception
      when Bad =>
         System.Memory.Free (Src.all'Address);
         return Checksum_Error;
   end Get_File_Checksum;

   ----------
   -- Hash --
   ----------

   function Hash (F : File_Name_Type) return Header_Num is
   begin
      return Header_Num (Int (F) rem Header_Num'Range_Length);
   end Hash;

   ---------------------------
   -- Initialize_ALI_Source --
   ---------------------------

   procedure Initialize_ALI_Source is
   begin
      --  When (re)initializing ALI data structures the ALI user expects to
      --  get a fresh set of data structures. Thus we first need to erase the
      --  marks put in the name table by the previous set of ALI routine calls.
      --  This loop is empty and harmless the first time in.

      for J in Source.First .. Source.Last loop
         Set_Name_Table_Info (Source.Table (J).Sfile, 0);
         Source.Table (J).Source_Found := False;
      end loop;

      Source.Init;
      Interfaces.Reset;
   end Initialize_ALI_Source;

   -------------------------
   -- Initialize_Checksum --
   -------------------------

   procedure Initialize_Checksum (Csum : out Word) is
   begin
      System.CRC32.Initialize (System.CRC32.CRC32 (Csum));
   end Initialize_Checksum;

   --------------
   -- Read_ALI --
   --------------

   procedure Read_ALI (Id : ALI_Id) is
      Afile  : File_Name_Type;
      Text   : Text_Buffer_Ptr;
      Idread : ALI_Id;

   begin
      --  Process all dependent units

      for U in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop
         for
           W in Units.Table (U).First_With .. Units.Table (U).Last_With
         loop
            Afile := Withs.Table (W).Afile;

            --  Only process if not a generic (Afile /= No_File) and if
            --  file has not been processed already.

            if Afile /= No_File
              and then Get_Name_Table_Info (Afile) = 0
            then
               Text := Read_Library_Info (Afile);

               --  Return with an error if source cannot be found and if this
               --  is not a library generic (now we can, but does not have to
               --  compile library generics)

               if Text = null then
                  if Generic_Separately_Compiled (Withs.Table (W).Sfile) then
                     Error_Msg_Name_1 := Afile;
                     Error_Msg_Name_2 := Withs.Table (W).Sfile;
                     Error_Msg ("% not found, % must be compiled");
                     Set_Name_Table_Info (Afile, Int (No_Unit_Id));
                     return;

                  else
                     goto Skip_Library_Generics;
                  end if;
               end if;

               --  Enter in ALIs table

               Idread :=
                 Scan_ALI
                   (F         => Afile,
                    T         => Text,
                    Ignore_ED => Force_RM_Elaboration_Order,
                    Err       => False);

               Free (Text);

               if ALIs.Table (Idread).Compile_Errors then
                  Error_Msg_Name_1 := Withs.Table (W).Sfile;
                  Error_Msg ("% had errors, must be fixed, and recompiled");
                  Set_Name_Table_Info (Afile, Int (No_Unit_Id));

               elsif ALIs.Table (Idread).No_Object then
                  Error_Msg_Name_1 := Withs.Table (W).Sfile;
                  Error_Msg ("% must be recompiled");
                  Set_Name_Table_Info (Afile, Int (No_Unit_Id));
               end if;

               --  If the Unit is an Interface to a Stand-Alone Library,
               --  set the Interface flag in the Withs table, so that its
               --  dependant are not considered for elaboration order.

               if ALIs.Table (Idread).Interface then
                  Withs.Table (W).Interface := True;
                  Interface_Library_Unit := True;

                  --  Set the entry in the Interfaces hash table, so that other
                  --  units that import this unit will set the flag in their
                  --  entry in the Withs table.

                  Interfaces.Set (Afile, True);

               else
                  --  Otherwise, recurse to get new dependents

                  Read_ALI (Idread);
               end if;

               <<Skip_Library_Generics>> null;

            --  If the ALI file has already been processed and is an interface,
            --  set the flag in the entry of the Withs table.

            elsif Interface_Library_Unit and then Interfaces.Get (Afile) then
               Withs.Table (W).Interface := True;
            end if;
         end loop;
      end loop;
   end Read_ALI;

   ----------------------
   -- Set_Source_Table --
   ----------------------

   procedure Set_Source_Table (A : ALI_Id) is
      F     : File_Name_Type;
      S     : Source_Id;
      Stamp : Time_Stamp_Type;

   begin
      Sdep_Loop : for D in
        ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
      loop
         F := Sdep.Table (D).Sfile;

         if F /= No_Name then

            --  If this is the first time we are seeing this source file,
            --  then make a new entry in the source table.

            if Get_Name_Table_Info (F) = 0 then
               Source.Increment_Last;
               S := Source.Last;
               Set_Name_Table_Info (F, Int (S));
               Source.Table (S).Sfile := F;
               Source.Table (S).All_Timestamps_Match := True;

               --  Initialize checksum fields

               Source.Table (S).Checksum := Sdep.Table (D).Checksum;
               Source.Table (S).All_Checksums_Match := True;

               --  In check source files mode, try to get time stamp from file

               if Opt.Check_Source_Files then
                  Stamp := Source_File_Stamp (F);

                  --  If we got the stamp, then set the stamp in the source
                  --  table entry and mark it as set from the source so that
                  --  it does not get subsequently changed.

                  if Stamp (Stamp'First) /= ' ' then
                     Source.Table (S).Stamp := Stamp;
                     Source.Table (S).Source_Found := True;

                  --  If we could not find the file, then the stamp is set
                  --  from the dependency table entry (to be possibly reset
                  --  if we find a later stamp in subsequent processing)

                  else
                     Source.Table (S).Stamp := Sdep.Table (D).Stamp;
                     Source.Table (S).Source_Found := False;

                     --  In All_Sources mode, flag error of file not found

                     if Opt.All_Sources then
                        Error_Msg_Name_1 := F;
                        Error_Msg ("cannot locate %");
                     end if;
                  end if;

               --  First time for this source file, but Check_Source_Files
               --  is off, so simply initialize the stamp from the Sdep entry

               else
                  Source.Table (S).Source_Found := False;
                  Source.Table (S).Stamp := Sdep.Table (D).Stamp;
               end if;

            --  Here if this is not the first time for this source file,
            --  so that the source table entry is already constructed.

            else
               S := Source_Id (Get_Name_Table_Info (F));

               --  Update checksum flag

               if not Checksums_Match
                        (Sdep.Table (D).Checksum, Source.Table (S).Checksum)
               then
                  Source.Table (S).All_Checksums_Match := False;
               end if;

               --  Check for time stamp mismatch

               if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then
                  Source.Table (S).All_Timestamps_Match := False;

                  --  When we have a time stamp mismatch, we go look for the
                  --  source file even if Check_Source_Files is false, since
                  --  if we find it, then we can use it to resolve which of the
                  --  two timestamps in the ALI files is likely to be correct.

                  if not Check_Source_Files then
                     Stamp := Source_File_Stamp (F);

                     if Stamp (Stamp'First) /= ' ' then
                        Source.Table (S).Stamp := Stamp;
                        Source.Table (S).Source_Found := True;
                     end if;
                  end if;

                  --  If the stamp in the source table entry was set from the
                  --  source file, then we do not change it (the stamp in the
                  --  source file is always taken as the "right" one).

                  if Source.Table (S).Source_Found then
                     null;

                  --  Otherwise, we have no source file available, so we guess
                  --  that the later of the two timestamps is the right one.
                  --  Note that this guess only affects which error messages
                  --  are issued later on, not correct functionality.

                  else
                     if Sdep.Table (D).Stamp > Source.Table (S).Stamp then
                        Source.Table (S).Stamp := Sdep.Table (D).Stamp;
                     end if;
                  end if;
               end if;
            end if;

            --  Set the checksum value in the source table

            S := Source_Id (Get_Name_Table_Info (F));
            Source.Table (S).Checksum := Sdep.Table (D).Checksum;
         end if;

      end loop Sdep_Loop;
   end Set_Source_Table;

   ----------------------
   -- Set_Source_Table --
   ----------------------

   procedure Set_Source_Table is
   begin
      for A in ALIs.First .. ALIs.Last loop
         Set_Source_Table (A);
      end loop;
   end Set_Source_Table;

   -------------------------
   -- Time_Stamp_Mismatch --
   -------------------------

   function Time_Stamp_Mismatch
     (A         : ALI_Id;
      Read_Only : Boolean := False)
      return      File_Name_Type
   is
      Src : Source_Id;
      --  Source file Id for the current Sdep entry

   begin
      for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
         Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));

         if Opt.Minimal_Recompilation
           and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
         then
            --  If minimal recompilation is in action, replace the stamp
            --  of the source file in the table if checksums match.

            --  ??? It is probably worth updating the ALI file with a new
            --  field to avoid recomputing it each time.

            if Checksums_Match
                 (Get_File_Checksum (Sdep.Table (D).Sfile),
                  Source.Table (Src).Checksum)
            then
               Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
            end if;

         end if;

         if (not Read_Only) or else Source.Table (Src).Source_Found then
            if not Source.Table (Src).Source_Found
              or else Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
            then
               --  If -t debug flag set, output time stamp found/expected

               if Source.Table (Src).Source_Found and Debug_Flag_T then
                  Write_Str ("Source: """);
                  Get_Name_String (Sdep.Table (D).Sfile);
                  Write_Str (Name_Buffer (1 .. Name_Len));
                  Write_Line ("""");

                  Write_Str ("   time stamp expected: ");
                  Write_Line (String (Sdep.Table (D).Stamp));

                  Write_Str ("      time stamp found: ");
                  Write_Line (String (Source.Table (Src).Stamp));
               end if;

               --  Return the source file

               return Source.Table (Src).Sfile;
            end if;
         end if;
      end loop;

      return No_File;
   end Time_Stamp_Mismatch;

end ALI.Util;
Commit	Line	Data
d23b8f57 RK	1	------------------------------------------------------------------------------
	2	-- --
	3	-- GNAT COMPILER COMPONENTS --
	4	-- --
	5	-- A L I . U T I L --
	6	-- --
	7	-- B o d y --
	8	-- --
bcea76b6	9	-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
d23b8f57 RK	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. --
71ff80dc	23	-- Extensive contributions were provided by Ada Core Technologies Inc. --
d23b8f57 RK	24	-- --
	25	------------------------------------------------------------------------------
	26
fbf5a39b	27	with Debug; use Debug;
d23b8f57	28	with Binderr; use Binderr;
fbf5a39b	29	with Lib; use Lib;
d23b8f57 RK	30	with Namet; use Namet;
d23b8f57 RK	31	with Opt; use Opt;
fbf5a39b	32	with Output; use Output;
d23b8f57 RK	33	with Osint; use Osint;
d23b8f57 RK	34
cfac6e9f	35	with System.CRC32;
07fc65c4	36	with System.Memory;
cfac6e9f	37
d23b8f57 RK	38	package body ALI.Util is
d23b8f57 RK	39
fbf5a39b AC	40	type Header_Num is range 0 .. 1_000;
	41
	42	function Hash (F : File_Name_Type) return Header_Num;
	43	-- Function used to compute hash of ALI file name
	44
	45	package Interfaces is new Simple_HTable (
	46	Header_Num => Header_Num,
	47	Element => Boolean,
	48	No_Element => False,
	49	Key => File_Name_Type,
	50	Hash => Hash,
	51	Equal => "=");
	52
d23b8f57 RK	53	-----------------------
	54	-- Local Subprograms --
	55	-----------------------
	56
	57	procedure Accumulate_Checksum (C : Character; Csum : in out Word);
	58	pragma Inline (Accumulate_Checksum);
	59	-- This routine accumulates the checksum given character C. During the
	60	-- scanning of a source file, this routine is called with every character
	61	-- in the source, excluding blanks, and all control characters (except
	62	-- that ESC is included in the checksum). Upper case letters not in string
	63	-- literals are folded by the caller. See Sinput spec for the documentation
	64	-- of the checksum algorithm. Note: checksum values are only used if we
	65	-- generate code, so it is not necessary to worry about making the right
	66	-- sequence of calls in any error situation.
	67
de4bf6cb	68	procedure Initialize_Checksum (Csum : out Word);
cfac6e9f PO	69	-- Sets initial value of Csum before any calls to Accumulate_Checksum
cfac6e9f PO	70
d23b8f57 RK	71	-------------------------
	72	-- Accumulate_Checksum --
	73	-------------------------
	74
	75	procedure Accumulate_Checksum (C : Character; Csum : in out Word) is
	76	begin
cfac6e9f	77	System.CRC32.Update (System.CRC32.CRC32 (Csum), C);
d23b8f57 RK	78	end Accumulate_Checksum;
d23b8f57 RK	79
cfac6e9f PO	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
d23b8f57 RK	89	-----------------------
	90	-- Get_File_Checksum --
	91	-----------------------
	92
	93	function Get_File_Checksum (Fname : Name_Id) return Word is
	94	Src : Source_Buffer_Ptr;
	95	Hi : Source_Ptr;
	96	Csum : Word;
	97	Ptr : Source_Ptr;
	98
	99	Bad : exception;
	100	-- Raised if file not found, or file format error
	101
	102	use ASCII;
	103	-- Make control characters visible
	104
d23b8f57 RK	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
cfac6e9f	116	Initialize_Checksum (Csum);
d23b8f57 RK	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
fbf5a39b	131	System.Memory.Free (Src.all'Address);
d23b8f57 RK	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 =>
fbf5a39b	263	System.Memory.Free (Src.all'Address);
cfac6e9f	264	return Checksum_Error;
d23b8f57 RK	265	end Get_File_Checksum;
d23b8f57 RK	266
fbf5a39b AC	267	----------
	268	-- Hash --
	269	----------
	270
	271	function Hash (F : File_Name_Type) return Header_Num is
	272	begin
	273	return Header_Num (Int (F) rem Header_Num'Range_Length);
	274	end Hash;
	275
d23b8f57 RK	276	---------------------------
	277	-- Initialize_ALI_Source --
	278	---------------------------
	279
	280	procedure Initialize_ALI_Source is
	281	begin
	282	-- When (re)initializing ALI data structures the ALI user expects to
	283	-- get a fresh set of data structures. Thus we first need to erase the
	284	-- marks put in the name table by the previous set of ALI routine calls.
	285	-- This loop is empty and harmless the first time in.
	286
	287	for J in Source.First .. Source.Last loop
	288	Set_Name_Table_Info (Source.Table (J).Sfile, 0);
	289	Source.Table (J).Source_Found := False;
	290	end loop;
	291
	292	Source.Init;
fbf5a39b	293	Interfaces.Reset;
d23b8f57 RK	294	end Initialize_ALI_Source;
d23b8f57 RK	295
cfac6e9f PO	296	-------------------------
	297	-- Initialize_Checksum --
	298	-------------------------
	299
de4bf6cb	300	procedure Initialize_Checksum (Csum : out Word) is
cfac6e9f PO	301	begin
	302	System.CRC32.Initialize (System.CRC32.CRC32 (Csum));
	303	end Initialize_Checksum;
	304
d23b8f57 RK	305	--------------
	306	-- Read_ALI --
	307	--------------
	308
	309	procedure Read_ALI (Id : ALI_Id) is
	310	Afile : File_Name_Type;
	311	Text : Text_Buffer_Ptr;
	312	Idread : ALI_Id;
	313
	314	begin
fbf5a39b	315	-- Process all dependent units
d23b8f57	316
fbf5a39b AC	317	for U in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop
	318	for
	319	W in Units.Table (U).First_With .. Units.Table (U).Last_With
	320	loop
	321	Afile := Withs.Table (W).Afile;
d23b8f57 RK	322
	323	-- Only process if not a generic (Afile /= No_File) and if
	324	-- file has not been processed already.
	325
fbf5a39b AC	326	if Afile /= No_File
	327	and then Get_Name_Table_Info (Afile) = 0
	328	then
d23b8f57 RK	329	Text := Read_Library_Info (Afile);
d23b8f57 RK	330
fbf5a39b AC	331	-- Return with an error if source cannot be found and if this
	332	-- is not a library generic (now we can, but does not have to
	333	-- compile library generics)
	334
d23b8f57	335	if Text = null then
fbf5a39b AC	336	if Generic_Separately_Compiled (Withs.Table (W).Sfile) then
	337	Error_Msg_Name_1 := Afile;
	338	Error_Msg_Name_2 := Withs.Table (W).Sfile;
	339	Error_Msg ("% not found, % must be compiled");
	340	Set_Name_Table_Info (Afile, Int (No_Unit_Id));
	341	return;
	342
	343	else
	344	goto Skip_Library_Generics;
	345	end if;
d23b8f57 RK	346	end if;
d23b8f57 RK	347
fbf5a39b AC	348	-- Enter in ALIs table
fbf5a39b AC	349
d23b8f57 RK	350	Idread :=
	351	Scan_ALI
	352	(F => Afile,
	353	T => Text,
	354	Ignore_ED => Force_RM_Elaboration_Order,
	355	Err => False);
	356
	357	Free (Text);
	358
	359	if ALIs.Table (Idread).Compile_Errors then
fbf5a39b	360	Error_Msg_Name_1 := Withs.Table (W).Sfile;
d23b8f57 RK	361	Error_Msg ("% had errors, must be fixed, and recompiled");
	362	Set_Name_Table_Info (Afile, Int (No_Unit_Id));
	363
	364	elsif ALIs.Table (Idread).No_Object then
fbf5a39b	365	Error_Msg_Name_1 := Withs.Table (W).Sfile;
d23b8f57 RK	366	Error_Msg ("% must be recompiled");
	367	Set_Name_Table_Info (Afile, Int (No_Unit_Id));
	368	end if;
	369
fbf5a39b AC	370	-- If the Unit is an Interface to a Stand-Alone Library,
	371	-- set the Interface flag in the Withs table, so that its
	372	-- dependant are not considered for elaboration order.
	373
	374	if ALIs.Table (Idread).Interface then
	375	Withs.Table (W).Interface := True;
	376	Interface_Library_Unit := True;
d23b8f57	377
fbf5a39b AC	378	-- Set the entry in the Interfaces hash table, so that other
	379	-- units that import this unit will set the flag in their
	380	-- entry in the Withs table.
	381
	382	Interfaces.Set (Afile, True);
	383
	384	else
	385	-- Otherwise, recurse to get new dependents
	386
	387	Read_ALI (Idread);
	388	end if;
	389
	390	<<Skip_Library_Generics>> null;
	391
	392	-- If the ALI file has already been processed and is an interface,
	393	-- set the flag in the entry of the Withs table.
	394
	395	elsif Interface_Library_Unit and then Interfaces.Get (Afile) then
	396	Withs.Table (W).Interface := True;
d23b8f57 RK	397	end if;
	398	end loop;
	399	end loop;
d23b8f57 RK	400	end Read_ALI;
	401
	402	----------------------
	403	-- Set_Source_Table --
	404	----------------------
	405
	406	procedure Set_Source_Table (A : ALI_Id) is
	407	F : File_Name_Type;
	408	S : Source_Id;
	409	Stamp : Time_Stamp_Type;
	410
	411	begin
	412	Sdep_Loop : for D in
	413	ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
	414	loop
	415	F := Sdep.Table (D).Sfile;
	416
fbf5a39b	417	if F /= No_Name then
d23b8f57	418
fbf5a39b AC	419	-- If this is the first time we are seeing this source file,
fbf5a39b AC	420	-- then make a new entry in the source table.
d23b8f57	421
fbf5a39b AC	422	if Get_Name_Table_Info (F) = 0 then
	423	Source.Increment_Last;
	424	S := Source.Last;
	425	Set_Name_Table_Info (F, Int (S));
	426	Source.Table (S).Sfile := F;
	427	Source.Table (S).All_Timestamps_Match := True;
d23b8f57	428
fbf5a39b	429	-- Initialize checksum fields
d23b8f57	430
fbf5a39b AC	431	Source.Table (S).Checksum := Sdep.Table (D).Checksum;
fbf5a39b AC	432	Source.Table (S).All_Checksums_Match := True;
d23b8f57	433
fbf5a39b	434	-- In check source files mode, try to get time stamp from file
d23b8f57	435
fbf5a39b AC	436	if Opt.Check_Source_Files then
fbf5a39b AC	437	Stamp := Source_File_Stamp (F);
d23b8f57	438
fbf5a39b AC	439	-- If we got the stamp, then set the stamp in the source
	440	-- table entry and mark it as set from the source so that
	441	-- it does not get subsequently changed.
d23b8f57	442
fbf5a39b AC	443	if Stamp (Stamp'First) /= ' ' then
	444	Source.Table (S).Stamp := Stamp;
	445	Source.Table (S).Source_Found := True;
d23b8f57	446
fbf5a39b AC	447	-- If we could not find the file, then the stamp is set
	448	-- from the dependency table entry (to be possibly reset
	449	-- if we find a later stamp in subsequent processing)
	450
	451	else
	452	Source.Table (S).Stamp := Sdep.Table (D).Stamp;
	453	Source.Table (S).Source_Found := False;
d23b8f57	454
fbf5a39b	455	-- In All_Sources mode, flag error of file not found
d23b8f57	456
fbf5a39b AC	457	if Opt.All_Sources then
	458	Error_Msg_Name_1 := F;
	459	Error_Msg ("cannot locate %");
	460	end if;
d23b8f57	461	end if;
d23b8f57	462
fbf5a39b AC	463	-- First time for this source file, but Check_Source_Files
fbf5a39b AC	464	-- is off, so simply initialize the stamp from the Sdep entry
d23b8f57	465
fbf5a39b AC	466	else
	467	Source.Table (S).Source_Found := False;
	468	Source.Table (S).Stamp := Sdep.Table (D).Stamp;
	469	end if;
d23b8f57	470
fbf5a39b AC	471	-- Here if this is not the first time for this source file,
fbf5a39b AC	472	-- so that the source table entry is already constructed.
d23b8f57	473
fbf5a39b AC	474	else
fbf5a39b AC	475	S := Source_Id (Get_Name_Table_Info (F));
d23b8f57	476
fbf5a39b	477	-- Update checksum flag
d23b8f57	478
fbf5a39b AC	479	if not Checksums_Match
	480	(Sdep.Table (D).Checksum, Source.Table (S).Checksum)
	481	then
	482	Source.Table (S).All_Checksums_Match := False;
	483	end if;
d23b8f57	484
fbf5a39b	485	-- Check for time stamp mismatch
d23b8f57	486
fbf5a39b AC	487	if Sdep.Table (D).Stamp /= Source.Table (S).Stamp then
fbf5a39b AC	488	Source.Table (S).All_Timestamps_Match := False;
d23b8f57	489
fbf5a39b AC	490	-- When we have a time stamp mismatch, we go look for the
	491	-- source file even if Check_Source_Files is false, since
	492	-- if we find it, then we can use it to resolve which of the
	493	-- two timestamps in the ALI files is likely to be correct.
d23b8f57	494
fbf5a39b AC	495	if not Check_Source_Files then
fbf5a39b AC	496	Stamp := Source_File_Stamp (F);
d23b8f57	497
fbf5a39b AC	498	if Stamp (Stamp'First) /= ' ' then
	499	Source.Table (S).Stamp := Stamp;
	500	Source.Table (S).Source_Found := True;
	501	end if;
d23b8f57	502	end if;
d23b8f57	503
fbf5a39b AC	504	-- If the stamp in the source table entry was set from the
	505	-- source file, then we do not change it (the stamp in the
	506	-- source file is always taken as the "right" one).
d23b8f57	507
fbf5a39b AC	508	if Source.Table (S).Source_Found then
fbf5a39b AC	509	null;
d23b8f57	510
fbf5a39b AC	511	-- Otherwise, we have no source file available, so we guess
	512	-- that the later of the two timestamps is the right one.
	513	-- Note that this guess only affects which error messages
	514	-- are issued later on, not correct functionality.
d23b8f57	515
fbf5a39b AC	516	else
	517	if Sdep.Table (D).Stamp > Source.Table (S).Stamp then
	518	Source.Table (S).Stamp := Sdep.Table (D).Stamp;
	519	end if;
d23b8f57 RK	520	end if;
	521	end if;
	522	end if;
d23b8f57	523
fbf5a39b	524	-- Set the checksum value in the source table
d23b8f57	525
fbf5a39b AC	526	S := Source_Id (Get_Name_Table_Info (F));
	527	Source.Table (S).Checksum := Sdep.Table (D).Checksum;
	528	end if;
d23b8f57 RK	529
d23b8f57 RK	530	end loop Sdep_Loop;
d23b8f57 RK	531	end Set_Source_Table;
	532
	533	----------------------
	534	-- Set_Source_Table --
	535	----------------------
	536
	537	procedure Set_Source_Table is
	538	begin
	539	for A in ALIs.First .. ALIs.Last loop
	540	Set_Source_Table (A);
	541	end loop;
d23b8f57 RK	542	end Set_Source_Table;
	543
	544	-------------------------
	545	-- Time_Stamp_Mismatch --
	546	-------------------------
	547
fbf5a39b AC	548	function Time_Stamp_Mismatch
	549	(A : ALI_Id;
	550	Read_Only : Boolean := False)
	551	return File_Name_Type
	552	is
d23b8f57 RK	553	Src : Source_Id;
	554	-- Source file Id for the current Sdep entry
	555
	556	begin
	557	for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
	558	Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
	559
	560	if Opt.Minimal_Recompilation
	561	and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
	562	then
d23b8f57 RK	563	-- If minimal recompilation is in action, replace the stamp
	564	-- of the source file in the table if checksums match.
	565
	566	-- ??? It is probably worth updating the ALI file with a new
	567	-- field to avoid recomputing it each time.
	568
cfac6e9f PO	569	if Checksums_Match
	570	(Get_File_Checksum (Sdep.Table (D).Sfile),
	571	Source.Table (Src).Checksum)
d23b8f57 RK	572	then
	573	Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
	574	end if;
	575
	576	end if;
	577
fbf5a39b AC	578	if (not Read_Only) or else Source.Table (Src).Source_Found then
	579	if not Source.Table (Src).Source_Found
	580	or else Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
	581	then
	582	-- If -t debug flag set, output time stamp found/expected
	583
	584	if Source.Table (Src).Source_Found and Debug_Flag_T then
	585	Write_Str ("Source: """);
	586	Get_Name_String (Sdep.Table (D).Sfile);
	587	Write_Str (Name_Buffer (1 .. Name_Len));
	588	Write_Line ("""");
	589
	590	Write_Str (" time stamp expected: ");
	591	Write_Line (String (Sdep.Table (D).Stamp));
	592
	593	Write_Str (" time stamp found: ");
	594	Write_Line (String (Source.Table (Src).Stamp));
	595	end if;
	596
	597	-- Return the source file
	598
	599	return Source.Table (Src).Sfile;
	600	end if;
d23b8f57 RK	601	end if;
	602	end loop;
	603
	604	return No_File;
d23b8f57 RK	605	end Time_Stamp_Mismatch;
	606
	607	end ALI.Util;