-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
'D' => True, -- dependency
'X' => True, -- xref
'S' => True, -- specific dispatching
+ 'Y' => True, -- limited_with
others => False);
--------------------
--------------
function Scan_ALI
- (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
+ (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;
+ Directly_Scanned : Boolean := False) return ALI_Id
is
P : Text_Ptr := T'First;
Line : Logical_Line_Number := 1;
function Get_Name
(Ignore_Spaces : Boolean := False;
- Ignore_Special : Boolean := False)return Name_Id;
+ Ignore_Special : 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).
-- If Lower is set to True then the Name_Buffer will be converted to
--
-- If Ignore_Special is False (normal case), the scan is terminated by
-- a typeref bracket or an equal sign except for the special case of
- -- an operator name starting with a double quite which is terminated
+ -- an operator name starting with a double quote which is terminated
-- by another double quote.
--
-- It is an error to set both Ignore_Spaces and Ignore_Special to True.
end if;
loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Getc;
+ Add_Char_To_Name_Buffer (Getc);
- exit when At_End_Of_Field and not Ignore_Spaces;
+ exit when At_End_Of_Field and then not Ignore_Spaces;
if not Ignore_Special then
if Name_Buffer (1) = '"' then
begin
Skip_Space;
- -- Check if we are on a number. In the case of bas ALI files, this
+ -- Check if we are on a number. In the case of bad ALI files, this
-- may not be true.
if not (Nextc in '0' .. '9') then
V := V * 10 + (Character'Pos (Getc) - Character'Pos ('0'));
exit when At_End_Of_Field;
- exit when Nextc < '0' or Nextc > '9';
+ exit when Nextc < '0' or else Nextc > '9';
end loop;
return V;
-- Acquire lines to be ignored
if Read_Xref then
- Ignore := ('U' | 'W' | 'D' | 'X' => False, others => True);
+ Ignore := ('U' | 'W' | 'Y' | 'D' | 'X' => False, others => True);
-- Read_Lines parameter given
Sfile => No_File,
Task_Dispatching_Policy => ' ',
Time_Slice_Value => -1,
- WC_Encoding => '8',
+ WC_Encoding => 'b',
Unit_Exception_Table => False,
Ver => (others => ' '),
Ver_Len => 0,
else
Checkc (' ');
- Name_Len := 0;
+ -- Scan out argument
+
+ Name_Len := 0;
while not At_Eol loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Getc;
+ Add_Char_To_Name_Buffer (Getc);
end loop;
+ -- If -fstack-check, record that it occurred
+
+ if Name_Buffer (1 .. Name_Len) = "-fstack-check" then
+ Stack_Check_Switch_Set := True;
+ end if;
+
+ -- Store the argument
+
Args.Increment_Last;
Args.Table (Args.Last) := new String'(Name_Buffer (1 .. Name_Len));
UL.First_Arg := First_Arg;
UL.Elab_Position := 0;
UL.SAL_Interface := ALIs.Table (Id).SAL_Interface;
+ UL.Directly_Scanned := Directly_Scanned;
UL.Body_Needed_For_SAL := False;
UL.Elaborate_Body_Desirable := False;
+ UL.Optimize_Alignment := 'O';
if Debug_Flag_U then
Write_Str (" ----> reading unit ");
Check_At_End_Of_Field;
+ -- OL/OO/OS/OT parameters
+
+ elsif C = 'O' then
+ C := Getc;
+
+ if C = 'L' or else C = 'O' or else C = 'S' or else C = 'T' then
+ Units.Table (Units.Last).Optimize_Alignment := C;
+ else
+ Fatal_Error_Ignore;
+ end if;
+
+ Check_At_End_Of_Field;
+
-- RC/RT parameters
elsif C = 'R' then
With_Loop : loop
Check_Unknown_Line;
- exit With_Loop when C /= 'W';
+ exit With_Loop when C /= 'W' and then C /= 'Y';
if Ignore ('W') then
Skip_Line;
Withs.Table (Withs.Last).Elab_Desirable := False;
Withs.Table (Withs.Last).Elab_All_Desirable := False;
Withs.Table (Withs.Last).SAL_Interface := False;
+ Withs.Table (Withs.Last).Limited_With := (C = 'Y');
-- Generic case with no object file available
end if;
end loop;
- Add_Char_To_Name_Buffer (nul);
+ Add_Char_To_Name_Buffer (NUL);
Skip_Eol;
end if;
if Nextc not in '0' .. '9' then
Name_Len := 0;
-
while not At_End_Of_Field loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Getc;
+ Add_Char_To_Name_Buffer (Getc);
end loop;
- Sdep.Table (Sdep.Last).Subunit_Name := Name_Enter;
+ -- Set the subunit name. Note that we use Name_Find rather
+ -- than Name_Enter here as the subunit name may already
+ -- have been put in the name table by the Project Manager.
+
+ Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
+
Skip_Space;
end if;
Name_Len := 0;
while not At_End_Of_Field loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Getc;
+ Add_Char_To_Name_Buffer (Getc);
end loop;
Sdep.Table (Sdep.Last).Rfile := Name_Enter;
end;
-- Interfaces are stored in the list of references,
- -- although the parent type itself is stored in XE
+ -- although the parent type itself is stored in XE.
+ -- The first interface (when there are only
+ -- interfaces) is stored in XE.Tref*)
elsif Ref = Tref_Derived
and then Typ = 'R'