-- --
-- 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- --
with Fname.UF; use Fname.UF;
with Lib.Util; use Lib.Util;
with Lib.Xref; use Lib.Xref;
+ use Lib.Xref.ALFA;
with Nlists; use Nlists;
with Gnatvsn; use Gnatvsn;
with Opt; use Opt;
with Osint; use Osint;
with Osint.C; use Osint.C;
with Par;
+with Par_SCO; use Par_SCO;
with Restrict; use Restrict;
with Rident; use Rident;
with Scn; use Scn;
Dynamic_Elab => False,
Fatal_Error => False,
Generate_Code => False,
+ Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
Loading => False,
Main_Priority => -1,
+ Main_CPU => -1,
Munit_Index => 0,
Serial_Number => 0,
Version => 0,
- Error_Location => No_Location);
+ Error_Location => No_Location,
+ OA_Setting => 'O');
end Add_Preprocessing_Dependency;
------------------------------
Dynamic_Elab => False,
Fatal_Error => False,
Generate_Code => False,
+ Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
Loading => False,
Main_Priority => -1,
+ Main_CPU => -1,
Munit_Index => 0,
Serial_Number => 0,
Version => 0,
- Error_Location => No_Location);
+ Error_Location => No_Location,
+ OA_Setting => 'O');
-- Parse system.ads so that the checksum is set right
-- Style checks are not applied.
Num_Sdep : Nat := 0;
-- Number of active entries in Sdep_Table
+ flag_compare_debug : Int;
+ pragma Import (C, flag_compare_debug);
+ -- Import from toplev.c
+
-----------------------
-- Local Subprograms --
-----------------------
-- Process with clause
-- Ada 2005 (AI-50217): limited with_clauses do not create
- -- dependencies
+ -- dependencies, but must be recorded as components of the
+ -- partition, in case there is no regular with_clause for
+ -- the unit anywhere else.
- if Nkind (Item) = N_With_Clause
- and then not (Limited_Present (Item))
- then
+ if Nkind (Item) = N_With_Clause then
Unum := Get_Cunit_Unit_Number (Library_Unit (Item));
With_Flags (Unum) := True;
- if Elaborate_Present (Item) then
- Elab_Flags (Unum) := True;
- end if;
+ if not Limited_Present (Item) then
+ if Elaborate_Present (Item) then
+ Elab_Flags (Unum) := True;
+ end if;
- if Elaborate_All_Present (Item) then
- Elab_All_Flags (Unum) := True;
- end if;
+ if Elaborate_All_Present (Item) then
+ Elab_All_Flags (Unum) := True;
+ end if;
- if Elaborate_All_Desirable (Item) then
- Elab_All_Des_Flags (Unum) := True;
- end if;
+ if Elaborate_All_Desirable (Item) then
+ Elab_All_Des_Flags (Unum) := True;
+ end if;
- if Elaborate_Desirable (Item) then
- Elab_Des_Flags (Unum) := True;
+ if Elaborate_Desirable (Item) then
+ Elab_Des_Flags (Unum) := True;
+ end if;
+
+ else
+ Set_From_With_Type (Cunit_Entity (Unum));
end if;
end if;
Write_Info_Str (" NE");
end if;
+ Write_Info_Str (" O");
+ Write_Info_Char (OA_Setting (Unit_Num));
+
+ if (Ekind (Uent) = E_Package
+ or else Ekind (Uent) = E_Package_Body)
+ and then Present (Finalizer (Uent))
+ then
+ Write_Info_Str (" PF");
+ end if;
+
if Is_Preelaborated (Uent) then
Write_Info_Str (" PR");
end if;
end case;
end if;
- if Initialize_Scalars then
+ if Initialize_Scalars or else Invalid_Value_Used then
Write_Info_Str (" IS");
end if;
for J in 1 .. Linker_Option_Lines.Last loop
declare
- S : constant Linker_Option_Entry :=
- Linker_Option_Lines.Table (J);
- C : Character;
-
+ S : Linker_Option_Entry renames Linker_Option_Lines.Table (J);
begin
if S.Unit = Unit_Num then
Write_Info_Initiate ('L');
- Write_Info_Str (" """);
+ Write_Info_Char (' ');
+ Write_Info_Slit (S.Option);
+ Write_Info_EOL;
+ end if;
+ end;
+ end loop;
+
+ -- Output notes
+
+ for J in 1 .. Notes.Last loop
+ declare
+ N : constant Node_Id := Notes.Table (J).Pragma_Node;
+ L : constant Source_Ptr := Sloc (N);
+ U : constant Unit_Number_Type := Notes.Table (J).Unit;
+ C : Character;
+
+ begin
+ if U = Unit_Num then
+ Write_Info_Initiate ('N');
+ Write_Info_Char (' ');
- for J in 1 .. String_Length (S.Option) loop
- C := Get_Character (Get_String_Char (S.Option, J));
+ case Chars (Pragma_Identifier (N)) is
+ when Name_Annotate =>
+ C := 'A';
+ when Name_Comment =>
+ C := 'C';
+ when Name_Ident =>
+ C := 'I';
+ when Name_Title =>
+ C := 'T';
+ when Name_Subtitle =>
+ C := 'S';
+ when others =>
+ raise Program_Error;
+ end case;
+
+ Write_Info_Char (C);
+ Write_Info_Int (Int (Get_Logical_Line_Number (L)));
+ Write_Info_Char (':');
+ Write_Info_Int (Int (Get_Column_Number (L)));
+
+ declare
+ A : Node_Id;
- if C in Character'Val (16#20#) .. Character'Val (16#7E#)
- and then C /= '{'
- then
- Write_Info_Char (C);
+ begin
+ A := First (Pragma_Argument_Associations (N));
+ while Present (A) loop
+ Write_Info_Char (' ');
- if C = '"' then
- Write_Info_Char (C);
+ if Chars (A) /= No_Name then
+ Write_Info_Name (Chars (A));
+ Write_Info_Char (':');
end if;
- else
declare
- Hex : constant array (0 .. 15) of Character :=
- "0123456789ABCDEF";
+ Expr : constant Node_Id := Expression (A);
begin
- Write_Info_Char ('{');
- Write_Info_Char (Hex (Character'Pos (C) / 16));
- Write_Info_Char (Hex (Character'Pos (C) mod 16));
- Write_Info_Char ('}');
+ if Nkind (Expr) = N_Identifier then
+ Write_Info_Name (Chars (Expr));
+
+ elsif Nkind (Expr) = N_Integer_Literal
+ and then Is_Static_Expression (Expr)
+ then
+ Write_Info_Uint (Intval (Expr));
+
+ elsif Nkind (Expr) = N_String_Literal
+ and then Is_Static_Expression (Expr)
+ then
+ Write_Info_Slit (Strval (Expr));
+
+ else
+ Write_Info_Str ("<expr>");
+ end if;
end;
- end if;
- end loop;
- Write_Info_Char ('"');
+ Next (A);
+ end loop;
+ end;
+
Write_Info_EOL;
end if;
end;
-- Loop to build the with table. A with on the main unit itself
-- is ignored (AARM 10.2(14a)). Such a with-clause can occur if
-- the main unit is a subprogram with no spec, and a subunit of
- -- it unecessarily withs the parent.
+ -- it unnecessarily withs the parent.
for J in Units.First + 1 .. Last_Unit loop
Uname := Units.Table (Unum).Unit_Name;
Fname := Units.Table (Unum).Unit_File_Name;
- Write_Info_Initiate ('W');
+ if Ekind (Cunit_Entity (Unum)) = E_Package
+ and then From_With_Type (Cunit_Entity (Unum))
+ then
+ Write_Info_Initiate ('Y');
+ else
+ Write_Info_Initiate ('W');
+ end if;
+
Write_Info_Char (' ');
Write_Info_Name (Uname);
Write_With_File_Names (Fname, Munit_Index (Unum));
end if;
- if Elab_Flags (Unum) then
- Write_Info_Str (" E");
- end if;
+ if Ekind (Cunit_Entity (Unum)) = E_Package
+ and then From_With_Type (Cunit_Entity (Unum))
+ then
+ null;
+ else
+ if Elab_Flags (Unum) then
+ Write_Info_Str (" E");
+ end if;
- if Elab_All_Flags (Unum) then
- Write_Info_Str (" EA");
- end if;
+ if Elab_All_Flags (Unum) then
+ Write_Info_Str (" EA");
+ end if;
- if Elab_Des_Flags (Unum) then
- Write_Info_Str (" ED");
- end if;
+ if Elab_Des_Flags (Unum) then
+ Write_Info_Str (" ED");
+ end if;
- if Elab_All_Des_Flags (Unum) then
- Write_Info_Str (" AD");
+ if Elab_All_Des_Flags (Unum) then
+ Write_Info_Str (" AD");
+ end if;
end if;
end if;
-- We never write an ALI file if the original operating mode was
-- syntax-only (-gnats switch used in compiler invocation line)
- if Original_Operating_Mode = Check_Syntax then
+ if Original_Operating_Mode = Check_Syntax
+ or flag_compare_debug /= 0
+ then
return;
end if;
- -- Build sorted source dependency table. We do this right away,
- -- because it is referenced by Up_To_Date_ALI_File_Exists.
+ -- Build sorted source dependency table. We do this right away, because
+ -- it is referenced by Up_To_Date_ALI_File_Exists.
for Unum in Units.First .. Last_Unit loop
if Cunit_Entity (Unum) = Empty
Lib.Sort (Sdep_Table (1 .. Num_Sdep));
- -- If we are not generating code, and there is an up to date
- -- ali file accessible, read it, and acquire the compilation
- -- arguments from this file.
+ -- If we are not generating code, and there is an up to date ALI file
+ -- file accessible, read it, and acquire the compilation arguments from
+ -- this file.
if Operating_Mode /= Generate_Code then
if Up_To_Date_ALI_File_Exists then
Write_Info_Nat (Opt.Time_Slice_Value);
end if;
+ if Has_Allocator (Main_Unit) then
+ Write_Info_Str (" AB");
+ end if;
+
+ if Main_CPU (Main_Unit) /= Default_Main_CPU then
+ Write_Info_Str (" C=");
+ Write_Info_Nat (Main_CPU (Main_Unit));
+ end if;
+
Write_Info_Str (" W=");
Write_Info_Char
(WC_Encoding_Letters (Wide_Character_Encoding_Method));
end if;
end Output_Main_Program_Line;
- -- Write command argmument ('A') lines
+ -- Write command argument ('A') lines
for A in 1 .. Compilation_Switches.Last loop
Write_Info_Initiate ('A');
end loop;
end;
- Output_References;
+ -- Output cross-references
+
+ if Opt.Xref_Active then
+ Output_References;
+ end if;
+
+ -- Output SCO information if present
+
+ if Generate_SCO then
+ SCO_Output;
+ end if;
+
+ -- Output ALFA information if needed
+
+ if Opt.Xref_Active and then ALFA_Mode then
+ Collect_ALFA (Sdep_Table => Sdep_Table, Num_Sdep => Num_Sdep);
+ Output_ALFA;
+ end if;
+
+ -- Output final blank line and we are done. This final blank line is
+ -- probably junk, but we don't feel like making an incompatible change!
+
Write_Info_Terminate;
Close_Output_Library_Info;
end Write_ALI;
projects / gcc.git / blobdiff