-- --
-- B o d y --
-- --
--- --
--- 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 Osint.C; use Osint.C;
with Par;
with Restrict; use Restrict;
+with Rident; use Rident;
with Scn; use Scn;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Stringt; use Stringt;
+with Tbuild; use Tbuild;
with Uname; use Uname;
with System.WCh_Con; use System.WCh_Con;
package body Lib.Writ is
+ ----------------------------------
+ -- Add_Preprocessing_Dependency --
+ ----------------------------------
+
+ procedure Add_Preprocessing_Dependency (S : Source_File_Index) is
+ begin
+ Units.Increment_Last;
+ Units.Table (Units.Last) :=
+ (Unit_File_Name => File_Name (S),
+ Unit_Name => No_Name,
+ Expected_Unit => No_Name,
+ Source_Index => S,
+ Cunit => Empty,
+ Cunit_Entity => Empty,
+ Dependency_Num => 0,
+ Dynamic_Elab => False,
+ Fatal_Error => False,
+ Generate_Code => False,
+ Has_RACW => False,
+ Ident_String => Empty,
+ Loading => False,
+ Main_Priority => -1,
+ Munit_Index => 0,
+ Serial_Number => 0,
+ Version => 0,
+ Error_Location => No_Location);
+ end Add_Preprocessing_Dependency;
+
------------------------------
-- Ensure_System_Dependency --
------------------------------
procedure Ensure_System_Dependency is
- Discard : List_Id;
-
System_Uname : Unit_Name_Type;
-- Unit name for system spec if needed for dummy entry
Cunit => Empty,
Cunit_Entity => Empty,
Dependency_Num => 0,
- Dependent_Unit => True,
Dynamic_Elab => False,
Fatal_Error => False,
Generate_Code => False,
Ident_String => Empty,
Loading => False,
Main_Priority => -1,
+ Munit_Index => 0,
Serial_Number => 0,
Version => 0,
Error_Location => No_Location);
-- Parse system.ads so that the checksum is set right
+ -- Style checks are not applied.
- Initialize_Scanner (Units.Last, System_Source_File_Index);
- Discard := Par (Configuration_Pragmas => False);
+ declare
+ Save_Mindex : constant Nat := Multiple_Unit_Index;
+ Save_Style : constant Boolean := Style_Check;
+ begin
+ Multiple_Unit_Index := 0;
+ Style_Check := False;
+ Initialize_Scanner (Units.Last, System_Source_File_Index);
+ Discard_List (Par (Configuration_Pragmas => False));
+ Style_Check := Save_Style;
+ Multiple_Unit_Index := Save_Mindex;
+ end;
end Ensure_System_Dependency;
---------------
Item := First (Context_Items (Cunit));
while Present (Item) loop
- if Nkind (Item) = N_With_Clause then
+ -- Ada 2005 (AI-50217): limited with_clauses do not create
+ -- dependencies
+
+ if Nkind (Item) = N_With_Clause
+ and then not (Limited_Present (Item))
+ then
Unum := Get_Cunit_Unit_Number (Library_Unit (Item));
With_Flags (Unum) := True;
Write_Info_Tab (49);
Write_Info_Str (Version_Get (Unit_Num));
+ if (Is_Subprogram (Uent)
+ or else Ekind (Uent) = E_Package
+ or else Is_Generic_Unit (Uent))
+ and then Body_Needed_For_SAL (Uent)
+ then
+ Write_Info_Str (" BN");
+ end if;
+
if Dynamic_Elab (Unit_Num) then
Write_Info_Str (" DE");
end if;
if Nkind (Unit (Unode)) in N_Unit_Body then
for S in Units.First .. Last_Unit loop
- -- We are only interested in subunits
+ -- We are only interested in subunits.
+ -- For preproc. data and def. files, Cunit is Empty, so
+ -- we need to test that first.
- if Nkind (Unit (Cunit (S))) = N_Subunit then
+ if Cunit (S) /= Empty
+ and then Nkind (Unit (Cunit (S))) = N_Subunit
+ then
Pnode := Library_Unit (Cunit (S));
-- In gnatc mode, the errors in the subunits will not
else
declare
- Hex : array (0 .. 15) of Character :=
+ Hex : constant array (0 .. 15) of Character :=
"0123456789ABCDEF";
begin
Pname : constant Unit_Name_Type :=
Get_Parent_Spec_Name (Unit_Name (Main_Unit));
Body_Fname : File_Name_Type;
+ Body_Index : Nat;
begin
-- Loop to build the with table. A with on the main unit itself
-- parent spec of the main unit (case of main unit is a child
-- unit). The latter with is not needed for semantic purposes,
-- but is required by the binder for elaboration purposes.
+ -- For preproc. data and def. files, there is no Unit_Name,
+ -- check for that first.
- if (With_Flags (J) or else Unit_Name (J) = Pname)
- and then Units.Table (J).Dependent_Unit
+ if Unit_Name (J) /= No_Name
+ and then (With_Flags (J) or else Unit_Name (J) = Pname)
then
Num_Withs := Num_Withs + 1;
With_Table (Num_Withs) := J;
if Is_Spec_Name (Uname) then
Body_Fname :=
- Get_File_Name (Get_Body_Name (Uname), Subunit => False);
+ Get_File_Name
+ (Get_Body_Name (Uname),
+ Subunit => False, May_Fail => True);
+
+ Body_Index :=
+ Get_Unit_Index
+ (Get_Body_Name (Uname));
+
+ if Body_Fname = No_File then
+ Body_Fname := Get_File_Name (Uname, Subunit => False);
+ Body_Index := Get_Unit_Index (Uname);
+ end if;
+
else
Body_Fname := Get_File_Name (Uname, Subunit => False);
+ Body_Index := Get_Unit_Index (Uname);
end if;
-- A package is considered to have a body if it requires
-- a body or if a body is present in Ada 83 mode.
if Body_Required (Cunit)
- or else (Ada_83
+ or else (Ada_Version = Ada_83
and then Full_Source_Name (Body_Fname) /= No_File)
then
Write_Info_Name (Body_Fname);
Write_Info_Tab (49);
- Write_Info_Name (Lib_File_Name (Body_Fname));
+ Write_Info_Name
+ (Lib_File_Name (Body_Fname, Body_Index));
else
Write_Info_Name (Fname);
Write_Info_Tab (49);
- Write_Info_Name (Lib_File_Name (Fname));
+ Write_Info_Name
+ (Lib_File_Name (Fname, Munit_Index (Unum)));
end if;
if Elab_Flags (Unum) then
end loop;
end Write_With_Lines;
- -- Start of processing for Writ_ALI
+ -- Start of processing for Write_ALI
begin
+ -- 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
+ return;
+ end if;
+
-- 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
- Num_Sdep := Num_Sdep + 1;
- Sdep_Table (Num_Sdep) := Unum;
+ if Cunit_Entity (Unum) = Empty
+ or else not From_With_Type (Cunit_Entity (Unum))
+ then
+ Num_Sdep := Num_Sdep + 1;
+ Sdep_Table (Num_Sdep) := Unum;
+ end if;
end loop;
-- Sort the table so that the D lines are in order
Write_Info_Initiate ('V');
Write_Info_Str (" """);
- Write_Info_Str (Library_Version);
+ Write_Info_Str (Verbose_Library_Version);
Write_Info_Char ('"');
Write_Info_EOL;
-- Output main program line if this is acceptable main program
- declare
+ Output_Main_Program_Line : declare
U : Node_Id := Unit (Units.Table (Main_Unit).Cunit);
S : Node_Id;
procedure M_Parameters;
-- Output parameters for main program line
+ ------------------
+ -- M_Parameters --
+ ------------------
+
procedure M_Parameters is
begin
if Main_Priority (Main_Unit) /= Default_Main_Priority then
Write_Info_EOL;
end M_Parameters;
+ -- Start of processing for Output_Main_Program_Line
+
begin
if Nkind (U) = N_Subprogram_Body
or else (Nkind (U) = N_Package_Body
end if;
end if;
end if;
- end;
+ end Output_Main_Program_Line;
-- Write command argmument ('A') lines
Write_Info_Str (" CE");
end if;
+ if Opt.Detect_Blocking then
+ Write_Info_Str (" DB");
+ end if;
+
if Opt.Float_Format /= ' ' then
Write_Info_Str (" F");
Write_Info_Str (" NO");
end if;
- if No_Run_Time then
+ if No_Run_Time_Mode then
Write_Info_Str (" NR");
end if;
Write_Info_Str (" NS");
end if;
+ if Sec_Stack_Used then
+ Write_Info_Str (" SS");
+ end if;
+
if Unreserve_All_Interrupts then
Write_Info_Str (" UA");
end if;
- if Exception_Mechanism /= Setjmp_Longjmp then
+ if Exception_Mechanism /= Front_End_Setjmp_Longjmp_Exceptions then
if Unit_Exception_Table_Present then
Write_Info_Str (" UX");
end if;
Write_Info_EOL;
+ -- Before outputting the restrictions line, update the setting of
+ -- the No_Elaboration_Code flag. Violations of this restriction
+ -- cannot be detected until after the backend has been called since
+ -- it is the backend that sets this flag. We have to check all units
+ -- for which we have generated code
+
+ for Unit in Units.First .. Last_Unit loop
+ if Units.Table (Unit).Generate_Code
+ or else Unit = Main_Unit
+ then
+ if not Has_No_Elaboration_Code (Cunit (Unit)) then
+ Main_Restrictions.Violated (No_Elaboration_Code) := True;
+ end if;
+ end if;
+ end loop;
+
-- Output restrictions line
Write_Info_Initiate ('R');
Write_Info_Char (' ');
- for J in All_Restrictions loop
- if Main_Restrictions (J) then
+ -- First the information for the boolean restrictions
+
+ for R in All_Boolean_Restrictions loop
+ if Main_Restrictions.Set (R)
+ and then not Restriction_Warnings (R)
+ then
Write_Info_Char ('r');
- elsif Violations (J) then
+ elsif Main_Restrictions.Violated (R) then
Write_Info_Char ('v');
else
Write_Info_Char ('n');
end if;
end loop;
+ -- And now the information for the parameter restrictions
+
+ for RP in All_Parameter_Restrictions loop
+ if Main_Restrictions.Set (RP)
+ and then not Restriction_Warnings (RP)
+ then
+ Write_Info_Char ('r');
+ Write_Info_Nat (Nat (Main_Restrictions.Value (RP)));
+ else
+ Write_Info_Char ('n');
+ end if;
+
+ if not Main_Restrictions.Violated (RP)
+ or else RP not in Checked_Parameter_Restrictions
+ then
+ Write_Info_Char ('n');
+ else
+ Write_Info_Char ('v');
+ Write_Info_Nat (Nat (Main_Restrictions.Count (RP)));
+
+ if Main_Restrictions.Unknown (RP) then
+ Write_Info_Char ('+');
+ end if;
+ end if;
+ end loop;
+
Write_Info_EOL;
+ -- Output interrupt state lines
+
+ for J in Interrupt_States.First .. Interrupt_States.Last loop
+ Write_Info_Initiate ('I');
+ Write_Info_Char (' ');
+ Write_Info_Nat (Interrupt_States.Table (J).Interrupt_Number);
+ Write_Info_Char (' ');
+ Write_Info_Char (Interrupt_States.Table (J).Interrupt_State);
+ Write_Info_Char (' ');
+ Write_Info_Nat
+ (Nat (Get_Logical_Line_Number
+ (Interrupt_States.Table (J).Pragma_Loc)));
+ Write_Info_EOL;
+ end loop;
+
-- Loop through file table to output information for all units for which
-- we have generated code, as marked by the Generate_Code flag.
Write_Info_Initiate ('D');
Write_Info_Char (' ');
- -- Normal case of a dependent unit entry with a source index
+ -- Normal case of a unit entry with a source index
- if Sind /= No_Source_File
- and then Units.Table (Unum).Dependent_Unit
- then
+ if Sind /= No_Source_File then
Write_Info_Name (File_Name (Sind));
Write_Info_Tab (25);
Write_Info_Str (String (Time_Stamp (Sind)));
Write_Info_Name (Reference_Name (Sind));
end if;
- -- Case where there is no source index (happens for missing files)
- -- Also come here for non-dependent units.
+ -- Case where there is no source index (happens for missing
+ -- files). In this case we write a dummy time stamp.
else
Write_Info_Name (Unit_File_Name (Unum));
OSDN Git Service
