procedure Walk_Library_Items is
type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean;
pragma Pack (Unit_Number_Set);
+
+ Main_CU : constant Node_Id := Cunit (Main_Unit);
+
Seen, Done : Unit_Number_Set := (others => False);
-- Seen (X) is True after we have seen unit X in the walk. This is used
-- to prevent processing the same unit more than once. Done (X) is True
-- this unit. If it's an instance body, do the spec first. If it is
-- an instance spec, do the body last.
+ procedure Do_Withed_Unit (Withed_Unit : Node_Id);
+ -- Apply Do_Unit_And_Dependents to a unit in a context clause.
+
+ procedure Process_Bodies_In_Context (Comp : Node_Id);
+ -- The main unit and its spec may depend on bodies that contain generics
+ -- that are instantiated in them. Iterate through the corresponding
+ -- contexts before processing main (spec/body) itself, to process bodies
+ -- that may be present, together with their context. The spec of main
+ -- is processed wherever it appears in the list of units, while the body
+ -- is processed as the last unit in the list.
+
---------------
-- Do_Action --
---------------
when N_Package_Body =>
- -- Package bodies are processed immediately after the
- -- corresponding spec.
+ -- Package bodies are processed separately if the main
+ -- unit depends on them.
null;
(Unit (Withed_Unit),
N_Generic_Package_Declaration,
N_Package_Body,
+ N_Package_Renaming_Declaration,
N_Subprogram_Body)
then
Write_Unit_Name
Write_Unit_Info (Unit_Num, Item, Withs => True);
end if;
- -- Main unit should come last (except in the case where we
+ -- Main unit should come last, except in the case where we
-- skipped System_Aux_Id, in which case we missed the things it
- -- depends on).
+ -- depends on, and in the case of parent bodies if present.
pragma Assert
- (not Done (Main_Unit) or else Present (System_Aux_Id));
+ (not Done (Main_Unit)
+ or else Present (System_Aux_Id)
+ or else Nkind (Item) = N_Package_Body);
-- We shouldn't do the same thing twice
Action (Item);
end Do_Action;
+ --------------------
+ -- Do_Withed_Unit --
+ --------------------
+
+ procedure Do_Withed_Unit (Withed_Unit : Node_Id) is
+ begin
+ Do_Unit_And_Dependents (Withed_Unit, Unit (Withed_Unit));
+ end Do_Withed_Unit;
+
----------------------------
-- Do_Unit_And_Dependents --
----------------------------
Unit_Num : constant Unit_Number_Type :=
Get_Cunit_Unit_Number (CU);
- procedure Do_Withed_Unit (Withed_Unit : Node_Id);
- -- Pass the buck to Do_Unit_And_Dependents
-
- --------------------
- -- Do_Withed_Unit --
- --------------------
-
- procedure Do_Withed_Unit (Withed_Unit : Node_Id) is
- Save_Do_Main : constant Boolean := Do_Main;
-
- begin
- -- Do not process the main unit if coming from a with_clause,
- -- as would happen with a parent body that has a child spec
- -- in its context.
-
- Do_Main := False;
- Do_Unit_And_Dependents (Withed_Unit, Unit (Withed_Unit));
- Do_Main := Save_Do_Main;
- end Do_Withed_Unit;
-
procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
-- Start of processing for Do_Unit_And_Dependents
Do_Withed_Units (CU, Include_Limited => False);
- -- Process the unit if it is a spec. If it is the main unit,
- -- process it only if we have done all other units.
+ -- Process the unit if it is a spec or the the main unit, if
+ -- it has no previous spec or we have done all other units.
if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body)
or else Acts_As_Spec (CU)
then
- if CU = Cunit (Main_Unit) and then not Do_Main then
+
+ if CU = Cunit (Main_Unit)
+ and then not Do_Main
+ then
Seen (Unit_Num) := False;
else
Seen (Unit_Num) := True;
+
+ if CU = Library_Unit (Main_CU) then
+ Process_Bodies_In_Context (CU);
+ end if;
+
Do_Action (CU, Item);
Done (Unit_Num) := True;
end if;
end if;
end if;
+ end Do_Unit_And_Dependents;
- -- Process bodies. The spec, if present, has been processed already.
- -- A body appears if it is the main, or the body of a spec that is
- -- in the context of the main unit, and that is instantiated, or else
- -- contains a generic that is instantiated, or a subprogram that is
- -- or a subprogram that is inlined in the main unit.
-
- -- We exclude bodies that may appear in a circular dependency list,
- -- where spec A depends on spec B and body of B depends on spec A.
- -- This is not an elaboration issue, but body B must be excluded
- -- from the processing.
+ -------------------------------
+ -- Process_Bodies_In_Context --
+ -------------------------------
- declare
- Body_Unit : Node_Id := Empty;
- Body_Num : Unit_Number_Type;
+ procedure Process_Bodies_In_Context (Comp : Node_Id) is
+ Body_CU : Node_Id;
+ Body_U : Unit_Number_Type;
+ Clause : Node_Id;
+ Spec : Node_Id;
- function Circular_Dependence (B : Node_Id) return Boolean;
- -- Check whether this body depends on a spec that is pending,
- -- that is to say has been seen but not processed yet.
+ procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
- -------------------------
- -- Circular_Dependence --
- -------------------------
+ function Depends_On_Main (CU : Node_Id) return Boolean;
+ -- The body of a unit that is withed by the spec of the main
+ -- unit may in turn have a with_clause on that spec. In that
+ -- case do not traverse the body, to prevent loops.
- function Circular_Dependence (B : Node_Id) return Boolean is
- Item : Node_Id;
- UN : Unit_Number_Type;
+ ---------------------
+ -- Depends_On_Main --
+ ---------------------
- begin
- Item := First (Context_Items (B));
- while Present (Item) loop
- if Nkind (Item) = N_With_Clause then
- UN := Get_Cunit_Unit_Number (Library_Unit (Item));
+ function Depends_On_Main (CU : Node_Id) return Boolean is
+ CL : Node_Id;
- if Seen (UN)
- and then not Done (UN)
- then
- return True;
- end if;
- end if;
+ begin
+ CL := First (Context_Items (CU));
- Next (Item);
- end loop;
+ -- Problem does not arise with main subprograms.
+ if Nkind (Unit (Main_CU)) /= N_Package_Body then
return False;
- end Circular_Dependence;
+ end if;
- begin
- if Nkind (Item) = N_Package_Declaration then
- Body_Unit := Library_Unit (CU);
+ while Present (CL) loop
+ if Nkind (CL) = N_With_Clause
+ and then Library_Unit (CL) = Library_Unit (Main_CU)
+ then
+ return True;
+ end if;
- elsif Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
- Body_Unit := CU;
- end if;
+ Next (CL);
+ end loop;
- if Present (Body_Unit)
+ return False;
+ end Depends_On_Main;
- -- Since specs and bodies are not done at the same time,
- -- guard against listing a body more than once. Bodies are
- -- only processed when the main unit is being processed,
- -- after all other units in the list. The DEC extension
- -- to System is excluded because of circularities.
+ -- Start of processing for Process_Bodies_In_Context
- and then not Seen (Get_Cunit_Unit_Number (Body_Unit))
- and then
- (No (System_Aux_Id)
- or else Unit_Num /= Get_Source_Unit (System_Aux_Id))
- and then not Circular_Dependence (Body_Unit)
- and then Do_Main
- then
- Body_Num := Get_Cunit_Unit_Number (Body_Unit);
- Seen (Body_Num) := True;
- Do_Action (Body_Unit, Unit (Body_Unit));
- Done (Body_Num) := True;
+ begin
+ Clause := First (Context_Items (Comp));
+ while Present (Clause) loop
+ if Nkind (Clause) = N_With_Clause then
+ Spec := Library_Unit (Clause);
+ Body_CU := Library_Unit (Spec);
+
+ if Present (Body_CU)
+ and then Body_CU /= Cunit (Main_Unit)
+ and then Nkind (Unit (Body_CU)) /= N_Subprogram_Body
+ then
+ Body_U := Get_Cunit_Unit_Number (Body_CU);
+
+ if not Seen (Body_U)
+ and then not Depends_On_Main (Body_CU)
+ then
+ Seen (Body_U) := True;
+ Do_Withed_Units (Body_CU, Include_Limited => False);
+ Do_Action (Body_CU, Unit (Body_CU));
+ Done (Body_U) := True;
+ end if;
+ end if;
end if;
- end;
- end Do_Unit_And_Dependents;
+
+ Next (Clause);
+ end loop;
+ end Process_Bodies_In_Context;
-- Local Declarations
- Cur : Elmt_Id;
+ Cur : Elmt_Id;
-- Start of processing for Walk_Library_Items
end;
end loop;
- -- Now traverse compilation units in order
+ -- Now traverse compilation units (specs) in order
Cur := First_Elmt (Comp_Unit_List);
while Present (Cur) loop
case Nkind (N) is
- -- If it's a body, ignore it. Bodies appear in the list only
- -- because of inlining/instantiations, and they are processed
- -- immediately after the corresponding specs. The main unit is
- -- processed separately after all other units.
+ -- If it is a subprogram body, process it if it has no
+ -- separate spec.
+
+ -- If it's a package body, ignore it, unless it is a body
+ -- created for an instance that is the main unit. In the
+ -- case of subprograms, the body is the wrapper package. In
+ -- case of a package, the original file carries the body,
+ -- and the spec appears as a later entry in the units list.
+
+ -- Otherwise Bodies appear in the list only because of
+ -- inlining/instantiations, and they are processed only
+ -- if relevant to the main unit. The main unit itself
+ -- is processed separately after all other specs.
- when N_Package_Body | N_Subprogram_Body =>
- null;
+ when N_Subprogram_Body =>
+ if Acts_As_Spec (N) then
+ Do_Unit_And_Dependents (CU, N);
+ end if;
+
+ when N_Package_Body =>
+ if CU = Main_CU
+ and then Nkind (Original_Node (Unit (Main_CU))) in
+ N_Generic_Instantiation
+ and then Present (Library_Unit (Main_CU))
+ then
+ Do_Unit_And_Dependents
+ (Library_Unit (Main_CU),
+ Unit (Library_Unit (Main_CU)));
+ end if;
- -- It's a spec, so just do it
+ -- It's a spec, process it, and the units it depends on.
when others =>
Do_Unit_And_Dependents (CU, N);
Next_Elmt (Cur);
end loop;
+ -- Now process package bodies on which main depends, followed by
+ -- bodies of parents, if present, and finally main itself.
+
if not Done (Main_Unit) then
Do_Main := True;
declare
- Main_CU : constant Node_Id := Cunit (Main_Unit);
+ Parent_CU : Node_Id;
+ Body_CU : Node_Id;
+ Body_U : Unit_Number_Type;
+ Child : Entity_Id;
begin
- -- If the main unit is an instantiation, the body appears before
- -- the instance spec, which is added later to the unit list. Do
- -- the spec if present, body will follow.
+ Process_Bodies_In_Context (Main_CU);
+
+ -- If the main unit is a child unit, parent bodies may be present
+ -- because they export instances or inlined subprograms. Check for
+ -- presence of these, which are not present in context clauses.
+
+ if Is_Child_Unit (Cunit_Entity (Main_Unit)) then
+ Child := Cunit_Entity (Main_Unit);
+
+ while Is_Child_Unit (Child) loop
+ Parent_CU :=
+ Cunit (Get_Cunit_Entity_Unit_Number (Scope (Child)));
+ Body_CU := Library_Unit (Parent_CU);
+
+ if Present (Body_CU)
+ and then not Seen (Get_Cunit_Unit_Number (Body_CU))
+ then
+ Body_U := Get_Cunit_Unit_Number (Body_CU);
+ Seen (Body_U) := True;
+ Do_Action (Body_CU, Unit (Body_CU));
+ Done (Body_U) := True;
+ end if;
- if Nkind (Original_Node (Unit (Main_CU)))
- in N_Generic_Instantiation
- and then Present (Library_Unit (Main_CU))
- then
- Do_Unit_And_Dependents
- (Library_Unit (Main_CU), Unit (Library_Unit (Main_CU)));
- else
- Do_Unit_And_Dependents (Main_CU, Unit (Main_CU));
+ Child := Scope (Child);
+ end loop;
end if;
+
+ Do_Action (Main_CU, Unit (Main_CU));
+ Done (Main_Unit) := True;
end;
end if;
projects / platform / upstream / linaro-gcc.git / commitdiff