-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
'U' => True, -- unit
'W' => True, -- with
'L' => True, -- linker option
+ 'N' => True, -- notes
'E' => True, -- external
'D' => True, -- dependency
'X' => True, -- xref
'S' => True, -- specific dispatching
+ 'Y' => True, -- limited_with
+ 'C' => True, -- SCO information
+ 'F' => True, -- Alfa information
others => False);
--------------------
Withs.Init;
Sdep.Init;
Linker_Options.Init;
+ Notes.Init;
Xref_Section.Init;
Xref_Entity.Init;
Xref.Init;
Version_Ref.Reset;
- -- Add dummy zero'th item in Linker_Options for the sort function
+ -- Add dummy zero'th item in Linker_Options and Notes for sort calls
Linker_Options.Increment_Last;
+ Notes.Increment_Last;
-- Initialize global variables recording cumulative options in all
-- ALI files that are read for a given processing run in gnatbind.
--------------
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
or else Nextc = '<' or else Nextc = '>'
or else Nextc = '=';
+ -- Terminate on comma
+
+ exit when Nextc = ',';
+
-- Terminate if left bracket not part of wide char sequence
-- Note that we only recognize brackets notation so far ???
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
Last_Unit => No_Unit_Id,
Locking_Policy => ' ',
Main_Priority => -1,
+ Main_CPU => -1,
Main_Program => None,
No_Object => False,
Normalize_Scalars => False,
Ofile_Full_Name => Full_Object_File_Name,
- Optimize_Alignment_Setting => 'O',
Queuing_Policy => ' ',
Restrictions => No_Restrictions,
SAL_Interface => False,
Sfile => No_File,
Task_Dispatching_Policy => ' ',
Time_Slice_Value => -1,
+ Allocator_In_Body => False,
WC_Encoding => 'b',
Unit_Exception_Table => False,
Ver => (others => ' '),
Skip_Space;
+ if Nextc = 'A' then
+ P := P + 1;
+ Checkc ('B');
+ ALIs.Table (Id).Allocator_In_Body := True;
+ end if;
+
+ Skip_Space;
+
+ if Nextc = 'C' then
+ P := P + 1;
+ Checkc ('=');
+ ALIs.Table (Id).Main_CPU := Get_Nat;
+ end if;
+
+ Skip_Space;
+
Checkc ('W');
Checkc ('=');
ALIs.Table (Id).WC_Encoding := Getc;
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
Fatal_Error_Ignore;
end if;
- -- Processing for Ox
-
- elsif C = 'O' then
- ALIs.Table (Id).Optimize_Alignment_Setting := Getc;
-
-- Processing for Qx
elsif C = 'Q' then
else
Skip_Space;
No_Deps.Append ((Id, Get_Name));
+ Skip_Eol;
end if;
- Skip_Eol;
C := Getc;
end loop;
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';
+ UL.Has_Finalizer := False;
if Debug_Flag_U then
Write_Str (" ----> reading unit ");
Fatal_Error_Ignore;
end if;
- -- PR/PU/PK parameters
+ -- PF/PR/PU/PK parameters
elsif C = 'P' then
C := Getc;
- if C = 'R' then
+ if C = 'F' then
+ Units.Table (Units.Last).Has_Finalizer := True;
+ elsif C = 'R' then
Units.Table (Units.Last).Preelab := True;
elsif C = 'U' then
Units.Table (Units.Last).Pure := True;
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;
Linker_Options.Table (Linker_Options.Last).Original_Pos :=
Linker_Options.Last;
end if;
+
+ -- If there are notes present, scan them
+
+ Notes_Loop : loop
+ Check_Unknown_Line;
+ exit Notes_Loop when C /= 'N';
+
+ if Ignore ('N') then
+ Skip_Line;
+
+ else
+ Checkc (' ');
+
+ Notes.Increment_Last;
+ Notes.Table (Notes.Last).Pragma_Type := Getc;
+ Notes.Table (Notes.Last).Pragma_Line := Get_Nat;
+ Checkc (':');
+ Notes.Table (Notes.Last).Pragma_Col := Get_Nat;
+ Notes.Table (Notes.Last).Unit := Units.Last;
+
+ if At_Eol then
+ Notes.Table (Notes.Last).Pragma_Args := No_Name;
+
+ else
+ Checkc (' ');
+
+ Name_Len := 0;
+ while not At_Eol loop
+ Add_Char_To_Name_Buffer (Getc);
+ end loop;
+
+ Notes.Table (Notes.Last).Pragma_Args := Name_Enter;
+ end if;
+
+ Skip_Eol;
+ end if;
+
+ C := Getc;
+ end loop Notes_Loop;
end loop U_Loop;
-- End loop through units for one ALI file
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;
-- Start of processing for Read_Refs_For_One_Entity
begin
- XE.Line := Get_Nat;
- XE.Etype := Getc;
- XE.Col := Get_Nat;
- XE.Lib := (Getc = '*');
+ XE.Line := Get_Nat;
+ XE.Etype := Getc;
+ XE.Col := Get_Nat;
+
+ case Getc is
+ when '*' =>
+ XE.Visibility := Global;
+ when '+' =>
+ XE.Visibility := Static;
+ when others =>
+ XE.Visibility := Other;
+ end case;
+
XE.Entity := Get_Name;
-- Handle the information about generic instantiations
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'
-- Imported entities reference as in:
-- 494b<c,__gnat_copy_attribs>25
- -- ??? Simply skipped for now
if Nextc = '<' then
- while Getc /= '>' loop
- null;
- end loop;
+ Skipc;
+ XR.Imported_Lang := Get_Name;
+
+ pragma Assert (Nextc = ',');
+ Skipc;
+
+ XR.Imported_Name := Get_Name;
+
+ pragma Assert (Nextc = '>');
+ Skipc;
+
+ else
+ XR.Imported_Lang := No_Name;
+ XR.Imported_Name := No_Name;
end if;
XR.Col := Get_Nat;
-- Here after dealing with xref sections
- if C /= EOF and then C /= 'X' then
- Fatal_Error;
- end if;
+ -- Ignore remaining lines, which belong to an additional section of the
+ -- ALI file not considered here (like SCO or Alfa).
+
+ Check_Unknown_Line;
return Id;
OSDN Git Service
