-- --
-- B o d y --
-- --
--- $Revision$
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-with Butil; use Butil;
-with Debug; use Debug;
-with Fname; use Fname;
-with Namet; use Namet;
-with Osint; use Osint;
-with Output; use Output;
+with Butil; use Butil;
+with Debug; use Debug;
+with Fname; use Fname;
+with Namet; use Namet;
+with Opt; use Opt;
+with Osint; use Osint;
+with Output; use Output;
package body ALI is
use ASCII;
-- Make control characters visible
+ -- The following variable records which characters currently are
+ -- used as line type markers in the ALI file. This is used in
+ -- Scan_ALI to detect (or skip) invalid lines.
+
+ Known_ALI_Lines : constant array (Character range 'A' .. 'Z') of Boolean :=
+ ('V' => True, -- version
+ 'M' => True, -- main program
+ 'A' => True, -- argument
+ 'P' => True, -- program
+ 'R' => True, -- restriction
+ 'I' => True, -- interrupt
+ 'U' => True, -- unit
+ 'W' => True, -- with
+ 'L' => True, -- linker option
+ 'E' => True, -- external
+ 'D' => True, -- dependency
+ 'X' => True, -- xref
+ others => False);
+
--------------------
-- Initialize_ALI --
--------------------
-- 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.
+ -- These two loops are empty and harmless the first time in.
for J in ALIs.First .. ALIs.Last loop
Set_Name_Table_Info (ALIs.Table (J).Afile, 0);
end loop;
+ for J in Units.First .. Units.Last loop
+ Set_Name_Table_Info (Units.Table (J).Uname, 0);
+ end loop;
+
+ -- Free argument table strings
+
+ for J in Args.First .. Args.Last loop
+ Free (Args.Table (J));
+ end loop;
+
+ -- Initialize all tables
+
ALIs.Init;
Units.Init;
Withs.Init;
No_Normalize_Scalars_Specified := False;
No_Object_Specified := False;
Normalize_Scalars_Specified := False;
- No_Run_Time_Specified := False;
Queuing_Policy_Specified := ' ';
Static_Elaboration_Model_Used := False;
Task_Dispatching_Policy_Specified := ' ';
Unreserve_All_Interrupts_Specified := False;
Zero_Cost_Exceptions_Specified := False;
-
end Initialize_ALI;
--------------
--------------
function Scan_ALI
- (F : File_Name_Type;
- T : Text_Buffer_Ptr;
- Ignore_ED : Boolean;
- Err : Boolean;
- Read_Xref : Boolean := False)
- return ALI_Id
+ (F : File_Name_Type;
+ T : Text_Buffer_Ptr;
+ Ignore_ED : Boolean;
+ Err : Boolean;
+ Read_Xref : Boolean := False;
+ Read_Lines : String := "";
+ Ignore_Lines : String := "X";
+ Ignore_Errors : Boolean := False) return ALI_Id
is
P : Text_Ptr := T'First;
Line : Logical_Line_Number := 1;
NS_Found : Boolean;
First_Arg : Arg_Id;
+ Ignore : array (Character range 'A' .. 'Z') of Boolean;
+ -- Ignore (X) is set to True if lines starting with X are to
+ -- be ignored by Scan_ALI and skipped, and False if the lines
+ -- are to be read and processed.
+
+ Restrictions_Initial : Rident.Restrictions_Info;
+ pragma Warnings (Off, Restrictions_Initial);
+ -- This variable, which should really be a constant (but that's not
+ -- allowed by the language) is used only for initialization, and the
+ -- reason we are declaring it is to get the default initialization
+ -- set for the object.
+
+ Bad_ALI_Format : exception;
+ -- Exception raised by Fatal_Error if Err is True
+
function At_Eol return Boolean;
-- Test if at end of line
procedure Checkc (C : Character);
-- Check next character is C. If so bump past it, if not fatal error
- Bad_ALI_Format : exception;
+ procedure Check_Unknown_Line;
+ -- If Ignore_Errors mode, then checks C to make sure that it is not
+ -- an unknown ALI line type characters, and if so, skips lines
+ -- until the first character of the line is one of these characters,
+ -- at which point it does a Getc to put that character in C. The
+ -- call has no effect if C is already an appropriate character.
+ -- If not in Ignore_Errors mode, a fatal error is signalled if the
+ -- line is unknown. Note that if C is an EOL on entry, the line is
+ -- skipped (it is assumed that blank lines are never significant).
+ -- If C is EOF on entry, the call has no effect (it is assumed that
+ -- the caller will properly handle this case).
procedure Fatal_Error;
-- Generate fatal error message for badly formatted ALI file if
-- Err is false, or raise Bad_ALI_Format if Err is True.
+ procedure Fatal_Error_Ignore;
+ pragma Inline (Fatal_Error_Ignore);
+ -- In Ignore_Errors mode, has no effect, otherwise same as Fatal_Error
+
function Getc return Character;
-- Get next character, bumping P past the character obtained
- function Get_Name (Lower : Boolean := False) return Name_Id;
+ function Get_Name
+ (Lower : Boolean := False;
+ Ignore_Spaces : Boolean := False) return Name_Id;
-- Skip blanks, then scan out a name (name is left in Name_Buffer with
- -- length in Name_Len, as well as being returned in Name_Id form). The
- -- name is adjusted appropriately if it refers to a file that is to be
- -- substituted by another name as a result of a configuration pragma.
- -- If Lower is set to true then the Name_Buffer will be converted to
- -- all lower case. This only happends for systems where file names are
- -- not case sensitive, and ensures that gnatbind works correctly on
- -- such systems, regardless of the case of the file name. Note that
- -- a name can be terminated by a right typeref bracket or '='.
+ -- length in Name_Len, as well as being returned in Name_Id form).
+ -- If Lower is set to True then the Name_Buffer will be converted to
+ -- all lower case, for systems where file names are not case sensitive.
+ -- This ensures that gnatbind works correctly regardless of the case
+ -- of the file name on all systems. The name is terminated by a either
+ -- white space (when Ignore_Spaces is False) or a typeref bracket or
+ -- an equal sign except for the special case of an operator name
+ -- starting with a double quite which is terminated by another double
+ -- quote.
function Get_Nat return Nat;
- -- Skip blanks, then scan out an unsigned integer value in Nat range
+ -- Skip blanks, then scan out an unsigned integer value in Nat range.
function Get_Stamp return Time_Stamp_Type;
-- Skip blanks, then scan out a time stamp
-- Return current character without modifying pointer P
procedure Skip_Eol;
- -- Skip past end of line (fatal error if not at end of line)
+ -- Skip past spaces, then skip past end of line (fatal error if not
+ -- at end of line). Also skips past any following blank lines.
+
+ procedure Skip_Line;
+ -- Skip rest of current line and any following blank lines.
procedure Skip_Space;
-- Skip past white space (blanks or horizontal tab)
+ procedure Skipc;
+ -- Skip past next character, does not affect value in C. This call
+ -- is like calling Getc and ignoring the returned result.
+
---------------------
-- At_End_Of_Field --
---------------------
procedure Check_At_End_Of_Field is
begin
if not At_End_Of_Field then
- Fatal_Error;
+ if Ignore_Errors then
+ while Nextc > ' ' loop
+ P := P + 1;
+ end loop;
+ else
+ Fatal_Error;
+ end if;
end if;
end Check_At_End_Of_Field;
begin
if Nextc = C then
P := P + 1;
+ elsif Ignore_Errors then
+ P := P + 1;
else
Fatal_Error;
end if;
end Checkc;
+ ------------------------
+ -- Check_Unknown_Line --
+ ------------------------
+
+ procedure Check_Unknown_Line is
+ begin
+ while C not in 'A' .. 'Z'
+ or else not Known_ALI_Lines (C)
+ loop
+ if C = CR or else C = LF then
+ Skip_Line;
+ C := Nextc;
+
+ elsif C = EOF then
+ return;
+
+ elsif Ignore_Errors then
+ Skip_Line;
+ C := Getc;
+
+ else
+ Fatal_Error;
+ end if;
+ end loop;
+ end Check_Unknown_Line;
+
-----------------
-- Fatal_Error --
-----------------
Exit_Program (E_Fatal);
end Fatal_Error;
+ ------------------------
+ -- Fatal_Error_Ignore --
+ ------------------------
+
+ procedure Fatal_Error_Ignore is
+ begin
+ if not Ignore_Errors then
+ Fatal_Error;
+ end if;
+ end Fatal_Error_Ignore;
+
--------------
-- Get_Name --
--------------
- function Get_Name (Lower : Boolean := False) return Name_Id is
+ function Get_Name
+ (Lower : Boolean := False;
+ Ignore_Spaces : Boolean := False) return Name_Id
+ is
begin
Name_Len := 0;
Skip_Space;
if At_Eol then
- Fatal_Error;
+ if Ignore_Errors then
+ return Error_Name;
+ else
+ Fatal_Error;
+ end if;
end if;
loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Getc;
- exit when At_End_Of_Field
- or else Nextc = ')'
- or else Nextc = '}'
- or else Nextc = '>'
- or else Nextc = '=';
+
+ exit when At_End_Of_Field and not Ignore_Spaces;
+
+ if Name_Buffer (1) = '"' then
+ exit when Name_Len > 1 and then Name_Buffer (Name_Len) = '"';
+
+ else
+ exit when (At_End_Of_Field and not Ignore_Spaces)
+ or else Nextc = '(' or else Nextc = ')'
+ or else Nextc = '{' or else Nextc = '}'
+ or else Nextc = '<' or else Nextc = '>'
+ or else Nextc = '=';
+ end if;
end loop;
-- Convert file name to all lower case if file names are not case
Skip_Space;
V := 0;
-
loop
V := V * 10 + (Character'Pos (Getc) - Character'Pos ('0'));
exit when At_End_Of_Field;
Skip_Space;
if At_Eol then
- Fatal_Error;
+ if Ignore_Errors then
+ return Dummy_Time_Stamp;
+ else
+ Fatal_Error;
+ end if;
end if;
-- Following reads old style time stamp missing first two digits
procedure Skip_Eol is
begin
Skip_Space;
- if not At_Eol then Fatal_Error; end if;
+
+ if not At_Eol then
+ if Ignore_Errors then
+ while not At_Eol loop
+ P := P + 1;
+ end loop;
+ else
+ Fatal_Error;
+ end if;
+ end if;
-- Loop to skip past blank lines (first time through skips this EOL)
end loop;
end Skip_Eol;
+ ---------------
+ -- Skip_Line --
+ ---------------
+
+ procedure Skip_Line is
+ begin
+ while not At_Eol loop
+ P := P + 1;
+ end loop;
+
+ Skip_Eol;
+ end Skip_Line;
+
----------------
-- Skip_Space --
----------------
end loop;
end Skip_Space;
- --------------------------------------
- -- Start of processing for Scan_ALI --
- --------------------------------------
+ -----------
+ -- Skipc --
+ -----------
+
+ procedure Skipc is
+ begin
+ if P /= T'Last then
+ P := P + 1;
+ end if;
+ end Skipc;
+
+ -- Start of processing for Scan_ALI
begin
+ First_Sdep_Entry := Sdep.Last + 1;
+
+ -- Acquire lines to be ignored
+
+ if Read_Xref then
+ Ignore := ('U' | 'W' | 'D' | 'X' => False, others => True);
+
+ -- Read_Lines parameter given
+
+ elsif Read_Lines /= "" then
+ Ignore := ('U' => False, others => True);
+
+ for J in Read_Lines'Range loop
+ Ignore (Read_Lines (J)) := False;
+ end loop;
+
+ -- Process Ignore_Lines parameter
+
+ else
+ Ignore := (others => False);
+
+ for J in Ignore_Lines'Range loop
+ pragma Assert (Ignore_Lines (J) /= 'U');
+ Ignore (Ignore_Lines (J)) := True;
+ end loop;
+ end if;
+
+ -- Setup ALI Table entry with appropriate defaults
+
ALIs.Increment_Last;
Id := ALIs.Last;
Set_Name_Table_Info (F, Int (Id));
ALIs.Table (Id) := (
Afile => F,
Compile_Errors => False,
+ First_Interrupt_State => Interrupt_States.Last + 1,
First_Sdep => No_Sdep_Id,
First_Unit => No_Unit_Id,
Float_Format => 'I',
+ Last_Interrupt_State => Interrupt_States.Last,
Last_Sdep => No_Sdep_Id,
Last_Unit => No_Unit_Id,
Locking_Policy => ' ',
Main_Priority => -1,
Main_Program => None,
No_Object => False,
- No_Run_Time => False,
Normalize_Scalars => False,
Ofile_Full_Name => Full_Object_File_Name,
Queuing_Policy => ' ',
- Restrictions => (others => ' '),
+ Restrictions => Restrictions_Initial,
Sfile => No_Name,
Task_Dispatching_Policy => ' ',
Time_Slice_Value => -1,
Unit_Exception_Table => False,
Ver => (others => ' '),
Ver_Len => 0,
+ Interface => False,
Zero_Cost_Exceptions => False);
- -- Acquire library version
+ -- Now we acquire the input lines from the ALI file. Note that the
+ -- convention in the following code is that as we enter each section,
+ -- C is set to contain the first character of the following line.
- Checkc ('V');
- Checkc (' ');
- Skip_Space;
- Checkc ('"');
+ C := Getc;
+ Check_Unknown_Line;
- for J in 1 .. Ver_Len_Max loop
- C := Getc;
- exit when C = '"';
- ALIs.Table (Id).Ver (J) := C;
- ALIs.Table (Id).Ver_Len := J;
- end loop;
+ -- Acquire library version
- Skip_Eol;
+ if C /= 'V' then
- -- Acquire main program line if present
+ -- The V line missing really indicates trouble, most likely it
+ -- means we don't have an ALI file at all, so here we give a
+ -- fatal error even if we are in Ignore_Errors mode.
- C := Getc;
+ Fatal_Error;
- if C = 'M' then
+ elsif Ignore ('V') then
+ Skip_Line;
+
+ else
Checkc (' ');
Skip_Space;
+ Checkc ('"');
- C := Getc;
+ for J in 1 .. Ver_Len_Max loop
+ C := Getc;
+ exit when C = '"';
+ ALIs.Table (Id).Ver (J) := C;
+ ALIs.Table (Id).Ver_Len := J;
+ end loop;
+
+ Skip_Eol;
+ end if;
+
+ C := Getc;
+ Check_Unknown_Line;
+
+ -- Acquire main program line if present
+
+ if C = 'M' then
+ if Ignore ('M') then
+ Skip_Line;
- if C = 'F' then
- ALIs.Table (Id).Main_Program := Func;
- elsif C = 'P' then
- ALIs.Table (Id).Main_Program := Proc;
else
- P := P - 1;
- Fatal_Error;
- end if;
+ Checkc (' ');
+ Skip_Space;
- Skip_Space;
+ C := Getc;
- if not At_Eol then
- if Nextc < 'A' then
- ALIs.Table (Id).Main_Priority := Get_Nat;
+ if C = 'F' then
+ ALIs.Table (Id).Main_Program := Func;
+ elsif C = 'P' then
+ ALIs.Table (Id).Main_Program := Proc;
+ else
+ P := P - 1;
+ Fatal_Error;
end if;
Skip_Space;
- if Nextc = 'T' then
- P := P + 1;
+ if not At_Eol then
+ if Nextc < 'A' then
+ ALIs.Table (Id).Main_Priority := Get_Nat;
+ end if;
+
+ Skip_Space;
+
+ if Nextc = 'T' then
+ P := P + 1;
+ Checkc ('=');
+ ALIs.Table (Id).Time_Slice_Value := Get_Nat;
+ end if;
+
+ Skip_Space;
+
+ Checkc ('W');
Checkc ('=');
- ALIs.Table (Id).Time_Slice_Value := Get_Nat;
+ ALIs.Table (Id).WC_Encoding := Getc;
end if;
- Skip_Space;
-
- Checkc ('W');
- Checkc ('=');
- ALIs.Table (Id).WC_Encoding := Getc;
+ Skip_Eol;
end if;
- Skip_Eol;
C := Getc;
-
end if;
-- Acquire argument lines
First_Arg := Args.Last + 1;
- Arg_Loop : while C = 'A' loop
- Checkc (' ');
- Name_Len := 0;
-
- while not At_Eol loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Getc;
- end loop;
+ A_Loop : loop
+ Check_Unknown_Line;
+ exit A_Loop when C /= 'A';
- Args.Increment_Last;
- Args.Table (Args.Last) := new String'(Name_Buffer (1 .. Name_Len));
+ if Ignore ('A') then
+ Skip_Line;
- Skip_Eol;
- C := Getc;
- end loop Arg_Loop;
+ else
+ Checkc (' ');
+ Name_Len := 0;
- -- Acquire P line, first set defaults
+ while not At_Eol loop
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := Getc;
+ end loop;
- if C /= 'P' then
- Fatal_Error;
- end if;
+ Args.Increment_Last;
+ Args.Table (Args.Last) := new String'(Name_Buffer (1 .. Name_Len));
- NS_Found := False;
+ Skip_Eol;
+ end if;
- while not At_Eol loop
- Checkc (' ');
- Skip_Space;
C := Getc;
+ end loop A_Loop;
+
+ -- Acquire P line
+
+ Check_Unknown_Line;
+
+ while C /= 'P' loop
+ if Ignore_Errors then
+ if C = EOF then
+ Fatal_Error;
+ else
+ Skip_Line;
+ C := Nextc;
+ end if;
+ else
+ Fatal_Error;
+ end if;
+ end loop;
- if C = 'C' then
- Checkc ('E');
- ALIs.Table (Id).Compile_Errors := True;
+ if Ignore ('P') then
+ Skip_Line;
- elsif C = 'F' then
- Float_Format_Specified := Getc;
- ALIs.Table (Id).Float_Format := Float_Format_Specified;
+ -- Process P line
- elsif C = 'L' then
- Locking_Policy_Specified := Getc;
- ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
+ else
+ NS_Found := False;
- elsif C = 'N' then
+ while not At_Eol loop
+ Checkc (' ');
+ Skip_Space;
C := Getc;
- if C = 'O' then
- ALIs.Table (Id).No_Object := True;
- No_Object_Specified := True;
+ -- Processing for CE
- elsif C = 'R' then
- No_Run_Time_Specified := True;
- ALIs.Table (Id).No_Run_Time := True;
+ if C = 'C' then
+ Checkc ('E');
+ ALIs.Table (Id).Compile_Errors := True;
+
+ -- Processing for FD/FG/FI
+
+ elsif C = 'F' then
+ Float_Format_Specified := Getc;
+ ALIs.Table (Id).Float_Format := Float_Format_Specified;
+
+ -- Processing for Lx
+
+ elsif C = 'L' then
+ Locking_Policy_Specified := Getc;
+ ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
+
+ -- Processing for flags starting with N
+
+ elsif C = 'N' then
+ C := Getc;
+
+ -- Processing for NO
+
+ if C = 'O' then
+ ALIs.Table (Id).No_Object := True;
+ No_Object_Specified := True;
+
+ -- Processing for NR
+
+ elsif C = 'R' then
+ No_Run_Time_Mode := True;
+ Configurable_Run_Time_Mode := True;
+
+ -- Processing for NS
+
+ elsif C = 'S' then
+ ALIs.Table (Id).Normalize_Scalars := True;
+ Normalize_Scalars_Specified := True;
+ NS_Found := True;
+
+ -- Invalid switch starting with N
+
+ else
+ Fatal_Error_Ignore;
+ end if;
+
+ -- Processing for Qx
+
+ elsif C = 'Q' then
+ Queuing_Policy_Specified := Getc;
+ ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
+
+ -- Processing for flags starting with S
elsif C = 'S' then
- ALIs.Table (Id).Normalize_Scalars := True;
- Normalize_Scalars_Specified := True;
- NS_Found := True;
+ C := Getc;
- else
- Fatal_Error;
- end if;
+ -- Processing for SL
+
+ if C = 'L' then
+ ALIs.Table (Id).Interface := True;
+
+ -- Processing for SS
+
+ elsif C = 'S' then
+ Opt.Sec_Stack_Used := True;
+
+ -- Invalid switch starting with S
- elsif C = 'Q' then
- Queuing_Policy_Specified := Getc;
- ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
+ else
+ Fatal_Error_Ignore;
+ end if;
+
+ -- Processing for Tx
- elsif C = 'T' then
- Task_Dispatching_Policy_Specified := Getc;
- ALIs.Table (Id).Task_Dispatching_Policy :=
- Task_Dispatching_Policy_Specified;
+ elsif C = 'T' then
+ Task_Dispatching_Policy_Specified := Getc;
+ ALIs.Table (Id).Task_Dispatching_Policy :=
+ Task_Dispatching_Policy_Specified;
- elsif C = 'U' then
- if Nextc = 'A' then
- Unreserve_All_Interrupts_Specified := True;
+ -- Processing for switch starting with U
+
+ elsif C = 'U' then
C := Getc;
+ -- Processing for UA
+
+ if C = 'A' then
+ Unreserve_All_Interrupts_Specified := True;
+
+ -- Processing for UX
+
+ elsif C = 'X' then
+ ALIs.Table (Id).Unit_Exception_Table := True;
+
+ -- Invalid switches starting with U
+
+ else
+ Fatal_Error_Ignore;
+ end if;
+
+ -- Processing for ZX
+
+ elsif C = 'Z' then
+ C := Getc;
+
+ if C = 'X' then
+ ALIs.Table (Id).Zero_Cost_Exceptions := True;
+ Zero_Cost_Exceptions_Specified := True;
+ else
+ Fatal_Error_Ignore;
+ end if;
+
+ -- Invalid parameter
+
else
- Checkc ('X');
- ALIs.Table (Id).Unit_Exception_Table := True;
+ C := Getc;
+ Fatal_Error_Ignore;
end if;
+ end loop;
+
+ if not NS_Found then
+ No_Normalize_Scalars_Specified := True;
+ end if;
- elsif C = 'Z' then
- Checkc ('X');
- ALIs.Table (Id).Zero_Cost_Exceptions := True;
- Zero_Cost_Exceptions_Specified := True;
+ Skip_Eol;
+ end if;
+
+ C := Getc;
+ Check_Unknown_Line;
+
+ -- Acquire restrictions line
+ while C /= 'R' loop
+ if Ignore_Errors then
+ if C = EOF then
+ Fatal_Error;
+ else
+ Skip_Line;
+ C := Nextc;
+ end if;
else
Fatal_Error;
end if;
end loop;
- if not NS_Found then
- No_Normalize_Scalars_Specified := True;
- end if;
+ if Ignore ('R') then
+ Skip_Line;
- Skip_Eol;
+ -- Process restrictions line
- -- Acquire restrictions line
+ else
+ Scan_Restrictions : declare
+ Save_R : constant Restrictions_Info := Cumulative_Restrictions;
+ -- Save cumulative restrictions in case we have a fatal error
- if Getc /= 'R' then
- Fatal_Error;
+ Bad_R_Line : exception;
+ -- Signal bad restrictions line
- else
- Checkc (' ');
- Skip_Space;
+ begin
+ Checkc (' ');
+ Skip_Space;
- for J in Partition_Restrictions loop
- C := Getc;
+ -- Acquire information for boolean restrictions
- if C = 'v' or else C = 'r' or else C = 'n' then
- ALIs.Table (Id).Restrictions (J) := C;
- else
- Fatal_Error;
- end if;
- end loop;
+ for R in All_Boolean_Restrictions loop
+ C := Getc;
+
+ case C is
+ when 'v' =>
+ ALIs.Table (Id).Restrictions.Violated (R) := True;
+ Cumulative_Restrictions.Violated (R) := True;
+
+ when 'r' =>
+ ALIs.Table (Id).Restrictions.Set (R) := True;
+ Cumulative_Restrictions.Set (R) := True;
+
+ when 'n' =>
+ null;
+
+ when others =>
+ Fatal_Error;
+ end case;
+ end loop;
+
+ -- Acquire information for parameter restrictions
+
+ for RP in All_Parameter_Restrictions loop
+
+ -- Acquire restrictions pragma information
+
+ case Getc is
+ when 'n' =>
+ null;
+
+ when 'r' =>
+ ALIs.Table (Id).Restrictions.Set (RP) := True;
+
+ declare
+ N : constant Integer := Integer (Get_Nat);
+ begin
+ ALIs.Table (Id).Restrictions.Value (RP) := N;
+
+ if Cumulative_Restrictions.Set (RP) then
+ Cumulative_Restrictions.Value (RP) :=
+ Integer'Min
+ (Cumulative_Restrictions.Value (RP), N);
+ else
+ Cumulative_Restrictions.Set (RP) := True;
+ Cumulative_Restrictions.Value (RP) := N;
+ end if;
+ end;
+
+ when others =>
+ Fatal_Error;
+ end case;
+
+ -- Acquire restrictions violations information
+
+ case Getc is
+ when 'n' =>
+ null;
+
+ when 'v' =>
+ ALIs.Table (Id).Restrictions.Violated (RP) := True;
+ Cumulative_Restrictions.Violated (RP) := True;
+
+ declare
+ N : constant Integer := Integer (Get_Nat);
+ pragma Unsuppress (Overflow_Check);
+
+ begin
+ ALIs.Table (Id).Restrictions.Count (RP) := N;
+
+ if RP in Checked_Max_Parameter_Restrictions then
+ Cumulative_Restrictions.Count (RP) :=
+ Integer'Max
+ (Cumulative_Restrictions.Count (RP), N);
+ else
+ Cumulative_Restrictions.Count (RP) :=
+ Cumulative_Restrictions.Count (RP) + N;
+ end if;
+
+ exception
+ when Constraint_Error =>
+
+ -- A constraint error comes from the addition in
+ -- the else branch. We reset to the maximum and
+ -- indicate that the real value is now unknown.
+
+ Cumulative_Restrictions.Value (RP) := Integer'Last;
+ Cumulative_Restrictions.Unknown (RP) := True;
+ end;
+
+ if Nextc = '+' then
+ Skipc;
+ ALIs.Table (Id).Restrictions.Unknown (RP) := True;
+ Cumulative_Restrictions.Unknown (RP) := True;
+ end if;
+
+ when others =>
+ Fatal_Error;
+ end case;
+ end loop;
- if At_Eol then
Skip_Eol;
- C := Getc;
+
+ -- Here if error during scanning of restrictions line
+
+ exception
+ when Bad_R_Line =>
+
+ -- In Ignore_Errors mode, undo any changes to restrictions
+ -- from this unit, and continue on.
+
+ if Ignore_Errors then
+ Cumulative_Restrictions := Save_R;
+ ALIs.Table (Id).Restrictions := Restrictions_Initial;
+
+ -- In normal mode, this is a fatal error
+
+ else
+ Fatal_Error;
+ end if;
+
+ end Scan_Restrictions;
+ end if;
+
+ -- Acquire 'I' lines if present
+
+ C := Getc;
+ Check_Unknown_Line;
+
+ while C = 'I' loop
+ if Ignore ('I') then
+ Skip_Line;
+
else
- Fatal_Error;
+ declare
+ Int_Num : Nat;
+ I_State : Character;
+ Line_No : Nat;
+
+ begin
+ Int_Num := Get_Nat;
+ Skip_Space;
+ I_State := Getc;
+ Line_No := Get_Nat;
+
+ Interrupt_States.Append (
+ (Interrupt_Id => Int_Num,
+ Interrupt_State => I_State,
+ IS_Pragma_Line => Line_No));
+
+ ALIs.Table (Id).Last_Interrupt_State := Interrupt_States.Last;
+ Skip_Eol;
+ end;
end if;
- end if;
+
+ C := Getc;
+ end loop;
-- Loop to acquire unit entries
- Unit_Loop : while C = 'U' loop
+ U_Loop : loop
+ Check_Unknown_Line;
+ exit U_Loop when C /= 'U';
+
+ -- Note: as per spec, we never ignore U lines
+
Checkc (' ');
Skip_Space;
Units.Increment_Last;
Units.Table (Units.Last).First_With := Withs.Last + 1;
Units.Table (Units.Last).First_Arg := First_Arg;
Units.Table (Units.Last).Elab_Position := 0;
+ Units.Table (Units.Last).Interface := ALIs.Table (Id).Interface;
if Debug_Flag_U then
Write_Str (" ----> reading unit ");
+ Write_Int (Int (Units.Last));
+ Write_Str (" ");
Write_Unit_Name (Units.Table (Units.Last).Uname);
Write_Str (" from file ");
Write_Name (Units.Table (Units.Last).Sfile);
and then Units.Table (Units.Last).Sfile /=
Units.Table (Unit_Id (Info)).Sfile
then
- -- If Err is set then treat duplicate unit name as an instance
- -- of a bad ALI format. This is the case of being called from
- -- gnatmake, and the point is that if anything is wrong with
- -- the ALI file, then gnatmake should just recompile.
+ -- If Err is set then ignore duplicate unit name. This is the
+ -- case of a call from gnatmake, where the situation can arise
+ -- from substitution of source files. In such situations, the
+ -- processing in gnatmake will always result in any required
+ -- recompilations in any case, and if we consider this to be
+ -- an error we get strange cases (for example when a generic
+ -- instantiation is replaced by a normal package) where we
+ -- read the old ali file, decide to recompile, and then decide
+ -- that the old and new ali files are incompatible.
if Err then
- raise Bad_ALI_Format;
+ null;
- -- If Err is not set, then this is a fatal error
+ -- If Err is not set, then this is a fatal error. This is
+ -- the case of being called from the binder, where we must
+ -- definitely diagnose this as an error.
else
Set_Standard_Error;
Units.Table (Units.Last).Version (J) := C;
end loop;
- -- DE parameter (Dynamic elaboration checks
+ -- BN parameter (Body needed)
+
+ elsif C = 'B' then
+ C := Getc;
+
+ if C = 'N' then
+ Check_At_End_Of_Field;
+ Units.Table (Units.Last).Body_Needed_For_SAL := True;
+ else
+ Fatal_Error_Ignore;
+ end if;
+
+
+ -- DE parameter (Dynamic elaboration checks)
elsif C = 'D' then
- Checkc ('E');
- Check_At_End_Of_Field;
- Units.Table (Units.Last).Dynamic_Elab := True;
- Dynamic_Elaboration_Checks_Specified := True;
+ C := Getc;
+
+ if C = 'E' then
+ Check_At_End_Of_Field;
+ Units.Table (Units.Last).Dynamic_Elab := True;
+ Dynamic_Elaboration_Checks_Specified := True;
+ else
+ Fatal_Error_Ignore;
+ end if;
-- EB/EE parameters
if C = 'B' then
Units.Table (Units.Last).Elaborate_Body := True;
-
elsif C = 'E' then
Units.Table (Units.Last).Set_Elab_Entity := True;
-
else
- Fatal_Error;
+ Fatal_Error_Ignore;
end if;
Check_At_End_Of_Field;
-- GE parameter (generic)
elsif C = 'G' then
- Checkc ('E');
- Check_At_End_Of_Field;
- Units.Table (Units.Last).Is_Generic := True;
+ C := Getc;
+
+ if C = 'E' then
+ Check_At_End_Of_Field;
+ Units.Table (Units.Last).Is_Generic := True;
+ else
+ Fatal_Error_Ignore;
+ end if;
-- IL/IS/IU parameters
if C = 'L' then
Units.Table (Units.Last).Icasing := All_Lower_Case;
-
elsif C = 'S' then
Units.Table (Units.Last).Init_Scalars := True;
Initialize_Scalars_Used := True;
-
elsif C = 'U' then
Units.Table (Units.Last).Icasing := All_Upper_Case;
-
else
- Fatal_Error;
+ Fatal_Error_Ignore;
end if;
Check_At_End_Of_Field;
if C = 'M' then
Units.Table (Units.Last).Kcasing := Mixed_Case;
-
elsif C = 'U' then
Units.Table (Units.Last).Kcasing := All_Upper_Case;
-
else
- Fatal_Error;
+ Fatal_Error_Ignore;
end if;
Check_At_End_Of_Field;
-- NE parameter
elsif C = 'N' then
- Checkc ('E');
- Units.Table (Units.Last).No_Elab := True;
- Check_At_End_Of_Field;
+ C := Getc;
+
+ if C = 'E' then
+ Units.Table (Units.Last).No_Elab := True;
+ Check_At_End_Of_Field;
+ else
+ Fatal_Error_Ignore;
+ end if;
+
-- PR/PU/PK parameters
elsif C = 'P' then
C := Getc;
- -- PR parameter (preelaborate)
-
if C = 'R' then
Units.Table (Units.Last).Preelab := True;
-
- -- PU parameter (pure)
-
elsif C = 'U' then
Units.Table (Units.Last).Pure := True;
-
- -- PK indicates unit is package
-
elsif C = 'K' then
Units.Table (Units.Last).Unit_Kind := 'p';
-
else
- Fatal_Error;
+ Fatal_Error_Ignore;
end if;
Check_At_End_Of_Field;
elsif C = 'R' then
C := Getc;
- -- RC parameter (remote call interface)
-
if C = 'C' then
Units.Table (Units.Last).RCI := True;
-
- -- RT parameter (remote types)
-
elsif C = 'T' then
Units.Table (Units.Last).Remote_Types := True;
-
- -- RA parameter (remote access to class wide type)
-
elsif C = 'A' then
Units.Table (Units.Last).Has_RACW := True;
-
else
- Fatal_Error;
+ Fatal_Error_Ignore;
end if;
Check_At_End_Of_Field;
elsif C = 'S' then
C := Getc;
- -- SP parameter (shared passive)
-
if C = 'P' then
Units.Table (Units.Last).Shared_Passive := True;
-
- -- SU parameter indicates unit is subprogram
-
elsif C = 'U' then
Units.Table (Units.Last).Unit_Kind := 's';
-
else
- Fatal_Error;
+ Fatal_Error_Ignore;
end if;
Check_At_End_Of_Field;
else
- Fatal_Error;
+ C := Getc;
+ Fatal_Error_Ignore;
end if;
-
end loop;
Skip_Eol;
Static_Elaboration_Model_Used := True;
end if;
- -- Scan out With lines for this unit
-
C := Getc;
- With_Loop : while C = 'W' loop
- Checkc (' ');
- Skip_Space;
- Withs.Increment_Last;
- Withs.Table (Withs.Last).Uname := Get_Name;
- Withs.Table (Withs.Last).Elaborate := False;
- Withs.Table (Withs.Last).Elaborate_All := False;
- Withs.Table (Withs.Last).Elab_All_Desirable := False;
-
- -- Generic case with no object file available
+ -- Scan out With lines for this unit
- if At_Eol then
- Withs.Table (Withs.Last).Sfile := No_File;
- Withs.Table (Withs.Last).Afile := No_File;
+ With_Loop : loop
+ Check_Unknown_Line;
+ exit With_Loop when C /= 'W';
- -- Normal case
+ if Ignore ('W') then
+ Skip_Line;
else
- Withs.Table (Withs.Last).Sfile := Get_Name (Lower => True);
- Withs.Table (Withs.Last).Afile := Get_Name;
+ Checkc (' ');
+ Skip_Space;
+ Withs.Increment_Last;
+ Withs.Table (Withs.Last).Uname := Get_Name;
+ Withs.Table (Withs.Last).Elaborate := False;
+ Withs.Table (Withs.Last).Elaborate_All := False;
+ Withs.Table (Withs.Last).Elab_All_Desirable := False;
+ Withs.Table (Withs.Last).Interface := False;
- -- Scan out possible E, EA, and NE parameters
+ -- Generic case with no object file available
- while not At_Eol loop
- Skip_Space;
+ if At_Eol then
+ Withs.Table (Withs.Last).Sfile := No_File;
+ Withs.Table (Withs.Last).Afile := No_File;
- if Nextc = 'E' then
- P := P + 1;
+ -- Normal case
+
+ else
+ Withs.Table (Withs.Last).Sfile := Get_Name (Lower => True);
+ Withs.Table (Withs.Last).Afile := Get_Name;
- if At_End_Of_Field then
- Withs.Table (Withs.Last).Elaborate := True;
+ -- Scan out possible E, EA, and NE parameters
- elsif Nextc = 'A' then
+ while not At_Eol loop
+ Skip_Space;
+
+ if Nextc = 'E' then
P := P + 1;
- Check_At_End_Of_Field;
- Withs.Table (Withs.Last).Elaborate_All := True;
- else
- Checkc ('D');
- Check_At_End_Of_Field;
+ if At_End_Of_Field then
+ Withs.Table (Withs.Last).Elaborate := True;
+
+ elsif Nextc = 'A' then
+ P := P + 1;
+ Check_At_End_Of_Field;
+ Withs.Table (Withs.Last).Elaborate_All := True;
+
+ else
+ Checkc ('D');
+ Check_At_End_Of_Field;
- -- Store ED indication unless ignore required
+ -- Store ED indication unless ignore required
- if not Ignore_ED then
- Withs.Table (Withs.Last).Elab_All_Desirable := True;
+ if not Ignore_ED then
+ Withs.Table (Withs.Last).Elab_All_Desirable :=
+ True;
+ end if;
end if;
end if;
- end if;
- end loop;
+ end loop;
+ end if;
+
+ Skip_Eol;
end if;
- Skip_Eol;
C := Getc;
-
end loop With_Loop;
Units.Table (Units.Last).Last_With := Withs.Last;
Units.Table (Units.Last).Last_Arg := Args.Last;
- end loop Unit_Loop;
+ -- If there are linker options lines present, scan them
+
+ Name_Len := 0;
+
+ Linker_Options_Loop : loop
+ Check_Unknown_Line;
+ exit Linker_Options_Loop when C /= 'L';
+
+ if Ignore ('L') then
+ Skip_Line;
+
+ else
+ Checkc (' ');
+ Skip_Space;
+ Checkc ('"');
+
+ loop
+ C := Getc;
+
+ if C < Character'Val (16#20#)
+ or else C > Character'Val (16#7E#)
+ then
+ Fatal_Error_Ignore;
+
+ elsif C = '{' then
+ C := Character'Val (0);
+
+ declare
+ V : Natural;
+
+ begin
+ V := 0;
+ for J in 1 .. 2 loop
+ C := Getc;
+
+ if C in '0' .. '9' then
+ V := V * 16 +
+ Character'Pos (C) -
+ Character'Pos ('0');
+
+ elsif C in 'A' .. 'F' then
+ V := V * 16 +
+ Character'Pos (C) -
+ Character'Pos ('A') +
+ 10;
+
+ else
+ Fatal_Error_Ignore;
+ end if;
+ end loop;
+
+ Checkc ('}');
+ Add_Char_To_Name_Buffer (Character'Val (V));
+ end;
+
+ else
+ if C = '"' then
+ exit when Nextc /= '"';
+ C := Getc;
+ end if;
+
+ Add_Char_To_Name_Buffer (C);
+ end if;
+ end loop;
+
+ Add_Char_To_Name_Buffer (nul);
+ Skip_Eol;
+ end if;
+
+ C := Getc;
+ end loop Linker_Options_Loop;
+
+ -- Store the linker options entry if one was found
+
+ if Name_Len /= 0 then
+ Linker_Options.Increment_Last;
+
+ Linker_Options.Table (Linker_Options.Last).Name :=
+ Name_Enter;
+
+ Linker_Options.Table (Linker_Options.Last).Unit :=
+ Units.Last;
+
+ Linker_Options.Table (Linker_Options.Last).Internal_File :=
+ Is_Internal_File_Name (F);
+
+ Linker_Options.Table (Linker_Options.Last).Original_Pos :=
+ Linker_Options.Last;
+ end if;
+ end loop U_Loop;
-- End loop through units for one ALI file
end if;
end if;
- -- If there are linker options lines present, scan them
-
- while C = 'L' loop
- Checkc (' ');
- Skip_Space;
- Checkc ('"');
-
- Name_Len := 0;
- loop
- C := Getc;
-
- if C < Character'Val (16#20#)
- or else C > Character'Val (16#7E#)
- then
- Fatal_Error;
-
- elsif C = '{' then
- C := Character'Val (0);
-
- declare
- V : Natural;
-
- begin
- V := 0;
- for J in 1 .. 2 loop
- C := Getc;
-
- if C in '0' .. '9' then
- V := V * 16 +
- Character'Pos (C) - Character'Pos ('0');
+ -- Scan out external version references and put in hash table
- elsif C in 'A' .. 'F' then
- V := V * 16 +
- Character'Pos (C) - Character'Pos ('A') + 10;
+ E_Loop : loop
+ Check_Unknown_Line;
+ exit E_Loop when C /= 'E';
- else
- Fatal_Error;
- end if;
- end loop;
+ if Ignore ('E') then
+ Skip_Line;
- Checkc ('}');
+ else
+ Checkc (' ');
+ Skip_Space;
- Add_Char_To_Name_Buffer (Character'Val (V));
- end;
+ Name_Len := 0;
+ Name_Len := 0;
+ loop
+ C := Getc;
- else
- if C = '"' then
- exit when Nextc /= '"';
- C := Getc;
+ if C < ' ' then
+ Fatal_Error;
end if;
+ exit when At_End_Of_Field;
Add_Char_To_Name_Buffer (C);
- end if;
- end loop;
+ end loop;
- Add_Char_To_Name_Buffer (nul);
+ Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
+ Skip_Eol;
+ end if;
- Skip_Eol;
C := Getc;
+ end loop E_Loop;
- Linker_Options.Increment_Last;
-
- Linker_Options.Table (Linker_Options.Last).Name
- := Name_Enter;
+ -- Scan out source dependency lines for this ALI file
- Linker_Options.Table (Linker_Options.Last).Unit
- := ALIs.Table (Id).First_Unit;
+ ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
- Linker_Options.Table (Linker_Options.Last).Internal_File
- := Is_Internal_File_Name (F);
+ D_Loop : loop
+ Check_Unknown_Line;
+ exit D_Loop when C /= 'D';
- Linker_Options.Table (Linker_Options.Last).Original_Pos
- := Linker_Options.Last;
+ if Ignore ('D') then
+ Skip_Line;
- end loop;
+ else
+ Checkc (' ');
+ Skip_Space;
+ Sdep.Increment_Last;
+ Sdep.Table (Sdep.Last).Sfile := Get_Name (Lower => True);
+ Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
+ Sdep.Table (Sdep.Last).Dummy_Entry :=
+ (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
- -- Scan out external version references and put in hash table
+ -- Acquire checksum value
- while C = 'E' loop
- Checkc (' ');
- Skip_Space;
+ Skip_Space;
- Name_Len := 0;
- Name_Len := 0;
- loop
- C := Getc;
+ declare
+ Ctr : Natural;
+ Chk : Word;
- if C < ' ' then
- Fatal_Error;
- end if;
+ begin
+ Ctr := 0;
+ Chk := 0;
- exit when At_End_Of_Field;
- Add_Char_To_Name_Buffer (C);
- end loop;
+ loop
+ exit when At_Eol or else Ctr = 8;
- Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
- Skip_Eol;
- C := Getc;
- end loop;
+ if Nextc in '0' .. '9' then
+ Chk := Chk * 16 +
+ Character'Pos (Nextc) - Character'Pos ('0');
- -- Scan out source dependency lines for this ALI file
+ elsif Nextc in 'a' .. 'f' then
+ Chk := Chk * 16 +
+ Character'Pos (Nextc) - Character'Pos ('a') + 10;
- ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
+ else
+ exit;
+ end if;
- while C = 'D' loop
- Checkc (' ');
- Skip_Space;
- Sdep.Increment_Last;
- Sdep.Table (Sdep.Last).Sfile := Get_Name (Lower => True);
- Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
+ Ctr := Ctr + 1;
+ P := P + 1;
+ end loop;
- -- Check for version number present, and if so store it
+ if Ctr = 8 and then At_End_Of_Field then
+ Sdep.Table (Sdep.Last).Checksum := Chk;
+ else
+ Fatal_Error;
+ end if;
+ end;
- Skip_Space;
+ -- Acquire subunit and reference file name entries
- declare
- Ctr : Natural;
- Chk : Word;
+ Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
+ Sdep.Table (Sdep.Last).Rfile :=
+ Sdep.Table (Sdep.Last).Sfile;
+ Sdep.Table (Sdep.Last).Start_Line := 1;
- begin
- Ctr := 0;
- Chk := 0;
+ if not At_Eol then
+ Skip_Space;
- loop
- exit when At_Eol or else Ctr = 8;
+ -- Here for subunit name
- if Nextc in '0' .. '9' then
- Chk := Chk * 16 +
- Character'Pos (Nextc) - Character'Pos ('0');
+ if Nextc not in '0' .. '9' then
+ Name_Len := 0;
- elsif Nextc in 'a' .. 'f' then
- Chk := Chk * 16 +
- Character'Pos (Nextc) - Character'Pos ('a') + 10;
+ while not At_End_Of_Field loop
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := Getc;
+ end loop;
- else
- exit;
+ Sdep.Table (Sdep.Last).Subunit_Name := Name_Enter;
+ Skip_Space;
end if;
- Ctr := Ctr + 1;
- P := P + 1;
- end loop;
-
- if Ctr = 8 and then At_End_Of_Field then
- Sdep.Table (Sdep.Last).Checksum := Chk;
- else
- Fatal_Error;
- end if;
- end;
-
- -- Acquire subunit and reference file name entries
+ -- Here for reference file name entry
- Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
- Sdep.Table (Sdep.Last).Rfile := Sdep.Table (Sdep.Last).Sfile;
- Sdep.Table (Sdep.Last).Start_Line := 1;
+ if Nextc in '0' .. '9' then
+ Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
+ Checkc (':');
- if not At_Eol then
- Skip_Space;
+ Name_Len := 0;
- -- Here for subunit name
+ while not At_End_Of_Field loop
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := Getc;
+ end loop;
- if Nextc not in '0' .. '9' then
- Name_Len := 0;
+ Sdep.Table (Sdep.Last).Rfile := Name_Enter;
+ end if;
+ end if;
- while not At_End_Of_Field loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Getc;
- end loop;
+ Skip_Eol;
+ end if;
- Sdep.Table (Sdep.Last).Subunit_Name := Name_Enter;
- Skip_Space;
- end if;
+ C := Getc;
+ end loop D_Loop;
- -- Here for reference file name entry
+ ALIs.Table (Id).Last_Sdep := Sdep.Last;
- if Nextc in '0' .. '9' then
- Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
- Checkc (':');
+ -- We must at this stage be at an Xref line or the end of file
- Name_Len := 0;
+ if C = EOF then
+ return Id;
+ end if;
- while not At_End_Of_Field loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Getc;
- end loop;
+ Check_Unknown_Line;
- Sdep.Table (Sdep.Last).Rfile := Name_Enter;
- end if;
- end if;
+ if C /= 'X' then
+ Fatal_Error;
+ end if;
- Skip_Eol;
- C := Getc;
- end loop;
+ -- If we are ignoring Xref sections we are done (we ignore all
+ -- remaining lines since only xref related lines follow X).
- ALIs.Table (Id).Last_Sdep := Sdep.Last;
+ if Ignore ('X') and then not Debug_Flag_X then
+ return Id;
+ end if;
- -- Loop through Xref sections (skip loop if not reading xref stuff)
+ -- Loop through Xref sections
- while Read_Xref and then C = 'X' loop
+ X_Loop : loop
+ Check_Unknown_Line;
+ exit X_Loop when C /= 'X';
-- Make new entry in section table
Current_File_Num := XS.File_Num;
+ Skip_Space;
+
Skip_Eol;
C := Nextc;
Xref_Entity.Increment_Last;
Read_Refs_For_One_Entity : declare
-
XE : Xref_Entity_Record renames
Xref_Entity.Table (Xref_Entity.Last);
-
- N : Nat;
+ N : Nat;
procedure Read_Instantiation_Reference;
-- Acquire instantiation reference. Caller has checked
----------------------------------
procedure Read_Instantiation_Reference is
+ Local_File_Num : Sdep_Id := Current_File_Num;
+
begin
Xref.Increment_Last;
if Nextc = '|' then
XR.File_Num :=
Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
- Current_File_Num := XR.File_Num;
+ Local_File_Num := XR.File_Num;
P := P + 1;
N := Get_Nat;
else
- XR.File_Num := Current_File_Num;
+ XR.File_Num := Local_File_Num;
end if;
XR.Line := N;
XE.Lib := (Getc = '*');
XE.Entity := Get_Name;
+ Current_File_Num := XS.File_Num;
+
-- Renaming reference is present
if Nextc = '=' then
XE.Tref_Line := 0;
XE.Tref_Type := ' ';
XE.Tref_Col := 0;
- XE.Tref_Standard_Entity := Get_Name;
+ XE.Tref_Standard_Entity :=
+ Get_Name (Ignore_Spaces => True);
else
N := Get_Nat;
XE.Tref_Standard_Entity := No_Name;
end if;
+ -- ??? Temporary workaround for nested generics case:
+ -- 4i4 Directories{1|4I9[4|6[3|3]]}
+ -- See C918-002
+
+ declare
+ Nested_Brackets : Natural := 0;
+
+ begin
+ loop
+ case Nextc is
+ when '[' =>
+ Nested_Brackets := Nested_Brackets + 1;
+ when ']' =>
+ Nested_Brackets := Nested_Brackets - 1;
+ when others =>
+ if Nested_Brackets = 0 then
+ exit;
+ end if;
+ end case;
+
+ Skipc;
+ end loop;
+ end;
+
P := P + 1; -- skip closing bracket
Skip_Space;
-- Loop through cross-references for this entity
- Current_File_Num := XS.File_Num;
-
loop
Skip_Space;
Current_File_Num := XR.File_Num;
P := P + 1;
N := Get_Nat;
-
else
XR.File_Num := Current_File_Num;
end if;
XR.Line := N;
XR.Rtype := Getc;
+
+ -- Imported entities reference as in:
+ -- 494b<c,__gnat_copy_attribs>25
+ -- ??? Simply skipped for now
+
+ if Nextc = '<' then
+ while Getc /= '>' loop
+ null;
+ end loop;
+ end if;
+
XR.Col := Get_Nat;
if Nextc = '[' then
XE.Last_Xref := Xref.Last;
C := Nextc;
-
end Read_Refs_For_One_Entity;
end loop;
end Read_Refs_For_One_File;
C := Getc;
- end loop;
+ end loop X_Loop;
-- Here after dealing with xref sections
projects / gcc.git / blobdiff