-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2018, 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 Par_SCO; use Par_SCO;
with Restrict; use Restrict;
with Rident; use Rident;
+with Stand; use Stand;
with Scn; use Scn;
with Sem_Eval; use Sem_Eval;
with Sinfo; use Sinfo;
begin
Units.Increment_Last;
Units.Table (Units.Last) :=
- (Unit_File_Name => File_Name (S),
- Unit_Name => No_Unit_Name,
- Expected_Unit => No_Unit_Name,
- Source_Index => S,
- Cunit => Empty,
- Cunit_Entity => Empty,
- Dependency_Num => 0,
- Dynamic_Elab => False,
- Fatal_Error => None,
- Generate_Code => False,
- Has_RACW => False,
- Filler => False,
- Ident_String => Empty,
- Loading => False,
- Main_Priority => -1,
- Main_CPU => -1,
- Munit_Index => 0,
- No_Elab_Code_All => False,
- Serial_Number => 0,
- Version => 0,
- Error_Location => No_Location,
- OA_Setting => 'O',
- SPARK_Mode_Pragma => Empty);
+ (Unit_File_Name => File_Name (S),
+ Unit_Name => No_Unit_Name,
+ Expected_Unit => No_Unit_Name,
+ Source_Index => S,
+ Cunit => Empty,
+ Cunit_Entity => Empty,
+ Dependency_Num => 0,
+ Dynamic_Elab => False,
+ Fatal_Error => None,
+ Generate_Code => False,
+ Has_RACW => False,
+ Filler => False,
+ Ident_String => Empty,
+ Is_Predefined_Renaming => False,
+ Is_Internal_Unit => False,
+ Is_Predefined_Unit => False,
+ Filler2 => False,
+ Loading => False,
+ Main_Priority => -1,
+ Main_CPU => -1,
+ Munit_Index => 0,
+ No_Elab_Code_All => False,
+ Primary_Stack_Count => 0,
+ Sec_Stack_Count => 0,
+ Serial_Number => 0,
+ Version => 0,
+ Error_Location => No_Location,
+ OA_Setting => 'O');
end Add_Preprocessing_Dependency;
------------------------------
System_Fname := File_Name (System_Source_File_Index);
Units.Increment_Last;
- Units.Table (Units.Last) := (
- Unit_File_Name => System_Fname,
- Unit_Name => System_Uname,
- Expected_Unit => System_Uname,
- Source_Index => System_Source_File_Index,
- Cunit => Empty,
- Cunit_Entity => Empty,
- Dependency_Num => 0,
- Dynamic_Elab => False,
- Fatal_Error => None,
- Generate_Code => False,
- Has_RACW => False,
- Filler => False,
- Ident_String => Empty,
- Loading => False,
- Main_Priority => -1,
- Main_CPU => -1,
- Munit_Index => 0,
- No_Elab_Code_All => False,
- Serial_Number => 0,
- Version => 0,
- Error_Location => No_Location,
- OA_Setting => 'O',
- SPARK_Mode_Pragma => Empty);
-
- -- Parse system.ads so that the checksum is set right,
- -- Style checks are not applied. The Ekind is set to ensure
- -- that this reference is always present in the ali file.
+ Units.Table (Units.Last) :=
+ (Unit_File_Name => System_Fname,
+ Unit_Name => System_Uname,
+ Expected_Unit => System_Uname,
+ Source_Index => System_Source_File_Index,
+ Cunit => Empty,
+ Cunit_Entity => Empty,
+ Dependency_Num => 0,
+ Dynamic_Elab => False,
+ Fatal_Error => None,
+ Generate_Code => False,
+ Has_RACW => False,
+ Filler => False,
+ Ident_String => Empty,
+ Is_Predefined_Renaming => False,
+ Is_Internal_Unit => True,
+ Is_Predefined_Unit => True,
+ Filler2 => False,
+ Loading => False,
+ Main_Priority => -1,
+ Main_CPU => -1,
+ Munit_Index => 0,
+ No_Elab_Code_All => False,
+ Primary_Stack_Count => 0,
+ Sec_Stack_Count => 0,
+ Serial_Number => 0,
+ Version => 0,
+ Error_Location => No_Location,
+ OA_Setting => 'O');
+
+ -- Parse system.ads so that the checksum is set right. Style checks are
+ -- not applied. The Ekind is set to ensure that this reference is always
+ -- present in the ali file.
declare
Save_Mindex : constant Nat := Multiple_Unit_Index;
Style_Check := False;
Initialize_Scanner (Units.Last, System_Source_File_Index);
Discard_List (Par (Configuration_Pragmas => False));
- Set_Ekind (Cunit_Entity (Units.Last), E_Package);
+ Set_Ekind (Cunit_Entity (Units.Last), E_Package);
+ Set_Scope (Cunit_Entity (Units.Last), Standard_Standard);
Style_Check := Save_Style;
Multiple_Unit_Index := Save_Mindex;
end;
-- Array of flags to show which units have Elaborate_All_Desirable set
type Yes_No is (Unknown, Yes, No);
- Implicit_With : array (Units.First .. Last_Unit) of Yes_No;
+ Has_Implicit_With : array (Units.First .. Last_Unit) of Yes_No;
-- Indicates if an implicit with has been given for the unit. Yes if
- -- certainly present, no if certainly absent, unkonwn if not known.
+ -- certainly present, No if certainly absent, Unknown if not known.
Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2));
-- Sorted table of source dependencies. One extra entry in case we
-----------------------
procedure Collect_Withs (Cunit : Node_Id);
- -- Collect with lines for entries in the context clause of the
- -- given compilation unit, Cunit.
+ -- Collect with lines for entries in the context clause of the given
+ -- compilation unit, Cunit.
procedure Update_Tables_From_ALI_File;
-- Given an up to date ALI file (see Up_To_Date_ALI_file_Exists
-------------------
procedure Collect_Withs (Cunit : Node_Id) is
+ function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean;
+ pragma Inline (Is_Implicit_With_Clause);
+ -- Determine whether a with clause denoted by Clause is implicit
+
+ -----------------------------
+ -- Is_Implicit_With_Clause --
+ -----------------------------
+
+ function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean is
+ begin
+ -- With clauses created for ancestor units are marked as internal,
+ -- however, they emulate the semantics in Ada RM 10.1.2 (6/2),
+ -- where
+ --
+ -- with A.B;
+ --
+ -- is almost equivalent to
+ --
+ -- with A;
+ -- with A.B;
+ --
+ -- For ALI encoding purposes, they are considered to be explicit.
+ -- Note that the clauses cannot be marked as explicit because they
+ -- will be subjected to various checks related to with clauses and
+ -- possibly cause false positives.
+
+ if Parent_With (Clause) then
+ return False;
+
+ else
+ return Implicit_With (Clause);
+ end if;
+ end Is_Implicit_With_Clause;
+
+ -- Local variables
+
Item : Node_Id;
Unum : Unit_Number_Type;
+ -- Start of processing for Collect_Withs
+
begin
Item := First (Context_Items (Cunit));
while Present (Item) loop
Set_From_Limited_With (Cunit_Entity (Unum));
end if;
- if Implicit_With (Unum) /= Yes then
- if Implicit_With_From_Instantiation (Item) then
- Implicit_With (Unum) := Yes;
+ if Is_Implicit_With_Clause (Item) then
+
+ -- A previous explicit with clause withs the unit. Retain
+ -- this classification, as it reflects the source relations
+ -- between units.
+
+ if Has_Implicit_With (Unum) = No then
+ null;
+
+ -- Otherwise this is either the first time any clause withs
+ -- the unit, or the unit is already implicitly withed.
+
else
- Implicit_With (Unum) := No;
+ Has_Implicit_With (Unum) := Yes;
end if;
+
+ -- Otherwise the current with clause is explicit. Such clauses
+ -- take precedence over existing implicit clauses because they
+ -- reflect the source relations between unit.
+
+ else
+ Has_Implicit_With (Unum) := No;
end if;
end if;
Write_Info_Str (" GE");
end if;
- if not Is_Internal_File_Name (Unit_File_Name (Unit_Num), True) then
+ if not Is_Internal_Unit (Unit_Num) then
case Identifier_Casing (Source_Index (Unit_Num)) is
when All_Lower_Case => Write_Info_Str (" IL");
when All_Upper_Case => Write_Info_Str (" IU");
Elab_All_Flags (J) := False;
Elab_Des_Flags (J) := False;
Elab_All_Des_Flags (J) := False;
- Implicit_With (J) := Unknown;
+ Has_Implicit_With (J) := Unknown;
end loop;
Collect_Withs (Unode);
Write_With_Lines;
+ -- Generate task stack lines
+
+ if Primary_Stack_Count (Unit_Num) > 0
+ or else Sec_Stack_Count (Unit_Num) > 0
+ then
+ Write_Info_Initiate ('T');
+ Write_Info_Char (' ');
+ Write_Info_Int (Primary_Stack_Count (Unit_Num));
+ Write_Info_Char (' ');
+ Write_Info_Int (Sec_Stack_Count (Unit_Num));
+ Write_Info_EOL;
+ end if;
+
-- Generate the linker option lines
for J in 1 .. Linker_Option_Lines.Last loop
-- parameters (see Lib_Writ spec for an explanation).
if Is_Generic_Unit (Cunit_Entity (Main_Unit))
- and then
- Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
+ and then Is_Predefined_Unit (Current_Sem_Unit)
and then Linker_Option_Lines.Table (J).Unit = Unit_Num
then
Set_Standard_Error;
Note_Unit := U;
end if;
- if Note_Unit = Unit_Num then
+ -- No action needed for pragmas removed by the expander (for
+ -- example, pragmas of ignored ghost entities).
+
+ if Nkind (N) = N_Null_Statement then
+ pragma Assert (Nkind (Original_Node (N)) = N_Pragma);
+ null;
+
+ elsif Note_Unit = Unit_Num then
Write_Info_Initiate ('N');
Write_Info_Char (' ');
- case Chars (Pragma_Identifier (N)) is
+ case Pragma_Name (N) is
when Name_Annotate =>
C := 'A';
when Name_Comment =>
-- Write source file name Nam and ALI file name for unit index Idx.
-- Possibly change Nam to lowercase (generating a new file name).
- --------------------------
- -- Write_With_File_Name --
- --------------------------
+ ---------------------------
+ -- Write_With_File_Names --
+ ---------------------------
procedure Write_With_File_Names
(Nam : in out File_Name_Type;
Uname := Units.Table (Unum).Unit_Name;
Fname := Units.Table (Unum).Unit_File_Name;
- if Implicit_With (Unum) = Yes then
- Write_Info_Initiate ('Z');
+ -- Limited with clauses must be processed first because they are
+ -- the most specific among the three kinds.
- elsif Ekind (Cunit_Entity (Unum)) = E_Package
+ if Ekind (Cunit_Entity (Unum)) = E_Package
and then From_Limited_With (Cunit_Entity (Unum))
then
Write_Info_Initiate ('Y');
+ elsif Has_Implicit_With (Unum) = Yes then
+ Write_Info_Initiate ('Z');
+
else
Write_Info_Initiate ('W');
end if;
if not ((Nkind (Unit (Cunit)) in N_Generic_Declaration
or else
Nkind (Unit (Cunit)) in N_Generic_Renaming_Declaration)
- and then Generic_May_Lack_ALI (Fname))
+ and then Generic_May_Lack_ALI (Unum))
-- In SPARK mode, always generate the dependencies on ALI
-- files, which are required to compute frame conditions
Write_Info_Tab (25);
if Is_Spec_Name (Uname) then
- Body_Fname :=
- 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;
+ -- In GNATprove mode we must write the spec of a unit which
+ -- requires a body if that body is not found. This will
+ -- allow partial analysis on incomplete sources. Also, in
+ -- the case of a unit that is a remote call interface, the
+ -- bodies of packages may not exist but still may form a
+ -- valid program - so we handle that here as well.
+
+ if GNATprove_Mode
+ or else Is_Remote_Call_Interface (Cunit_Entity (Unum))
+ then
+ Body_Fname :=
+ Get_File_Name
+ (Uname => 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;
+
+ -- In the normal path we don't allow failure in fetching the
+ -- name of the desired body unit so that it may be properly
+ -- referenced in the output ali - even if it is missing.
+
+ else
+ Body_Fname :=
+ Get_File_Name
+ (Uname => Get_Body_Name (Uname),
+ Subunit => False,
+ May_Fail => False);
+
+ Body_Index := Get_Unit_Index (Get_Body_Name (Uname));
+ end if;
else
Body_Fname := Get_File_Name (Uname, Subunit => False);
Body_Index := Get_Unit_Index (Uname);
if Cunit_Entity (Unum) = Empty
or else not From_Limited_With (Cunit_Entity (Unum))
then
- Num_Sdep := Num_Sdep + 1;
- Sdep_Table (Num_Sdep) := Unum;
+ -- Units that are not analyzed need not appear in the dependency
+ -- list. These units are either units appearing in limited_with
+ -- clauses of other units, or units loaded for inlining that end
+ -- up not inlined by a later decision of the inlining code, to
+ -- prevent circularities. We want to exclude these files from the
+ -- list of dependencies, so that the dependency number of other
+ -- is correctly set, as that number is used by cross-reference
+ -- tools to relate entity information to the unit in which they
+ -- are declared.
+
+ if Present (Cunit_Entity (Unum))
+ and then Ekind (Cunit_Entity (Unum)) = E_Void
+ and then Nkind (Unit (Cunit (Unum))) /= N_Subunit
+ and then Serious_Errors_Detected = 0
+ then
+ null;
+
+ else
+ Num_Sdep := Num_Sdep + 1;
+ Sdep_Table (Num_Sdep) := Unum;
+ end if;
end if;
end loop;
Write_Info_Str (" DB");
end if;
- if Tasking_Used
- and then not Is_Predefined_File_Name (Unit_File_Name (Main_Unit))
- then
+ if Tasking_Used and then not Is_Predefined_Unit (Main_Unit) then
if Locking_Policy /= ' ' then
Write_Info_Str (" L");
Write_Info_Char (Locking_Policy);
Write_Info_Char (Partition_Elaboration_Policy);
end if;
+ if No_Component_Reordering_Config then
+ Write_Info_Str (" NC");
+ end if;
+
if not Object then
Write_Info_Str (" NO");
end if;
Units.Table (Unum).Dependency_Num := J;
Sind := Units.Table (Unum).Source_Index;
- -- The dependency table also contains units that appear in the
- -- context of a unit loaded through a limited_with clause. These
- -- units are never analyzed, and thus the main unit does not
- -- really have a dependency on them.
-
- if Present (Cunit_Entity (Unum))
- and then Ekind (Cunit_Entity (Unum)) = E_Void
- then
- goto Next_Unit;
- end if;
-
Write_Info_Initiate ('D');
Write_Info_Char (' ');
-- Normal case of a unit entry with a source index
- if Sind /= No_Source_File then
- Fname := File_Name (Sind);
+ if Sind > No_Source_File then
+ -- We never want directory information in ALI files
+ -- ???But back out this change temporarily until
+ -- gprbuild is fixed.
- -- Ensure that on platforms where the file names are not case
- -- sensitive, the recorded file name is in lower case.
+ if False then
+ Fname := Strip_Directory (File_Name (Sind));
+ else
+ Fname := File_Name (Sind);
+ end if;
+
+ -- Ensure that on platforms where the file names are not
+ -- case sensitive, the recorded file name is in lower case.
if not File_Names_Case_Sensitive then
Get_Name_String (Fname);
Write_Info_Char (' ');
Write_Info_Str (Get_Hex_String (Source_Checksum (Sind)));
- -- If the dependency comes from a limited_with clause,
- -- record limited_checksum.
- -- Disable for now, until full checksum changes are checked.
+ -- If the dependency comes from a limited_with clause, record
+ -- limited_checksum. This is disabled until full checksum
+ -- changes are checked.
-- if Present (Cunit_Entity (Unum))
-- and then From_Limited_With (Cunit_Entity (Unum))
end if;
Write_Info_EOL;
-
- <<Next_Unit>>
- null;
end loop;
end;
SCO_Output;
end if;
- -- Output SPARK cross-reference information if needed
-
- if Opt.Xref_Active and then GNATprove_Mode then
- SPARK_Specific.Collect_SPARK_Xrefs (Sdep_Table => Sdep_Table,
- Num_Sdep => Num_Sdep);
- SPARK_Specific.Output_SPARK_Xrefs;
- 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.
projects / gcc.git / blobdiff