Callee : Entity_Id;
procedure Check_Static_Type
- (T : Entity_Id;
- N : Node_Id;
- DT : in out Boolean);
+ (T : Entity_Id; N : Node_Id; DT : in out Boolean);
-- Given a type T, checks if it is a static type defined as a type
-- with no dynamic bounds in sight. If so, the only action is to
-- set Is_Static_Type True for T. If T is not a static type, then
-- from within Caller to entity E declared in Callee. E can be a
-- an object or a type.
+ procedure Register_Subprogram (E : Entity_Id; Bod : Node_Id);
+ -- Enter a subprogram whose body is visible or which is a
+ -- subprogram instance into the subprogram table.
+
-----------------------
-- Check_Static_Type --
-----------------------
procedure Check_Static_Type
- (T : Entity_Id;
- N : Node_Id;
- DT : in out Boolean)
+ (T : Entity_Id; N : Node_Id; DT : in out Boolean)
is
procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id);
-- N is the bound of a dynamic type. This procedure notes that
begin
-- Entity name case. Make sure that the entity is declared
-- in a subprogram. This may not be the case for for a type
- -- in a loop appearing in a precondition. Exclude explicitly
- -- discriminants (that can appear in bounds of discriminated
- -- components).
+ -- in a loop appearing in a precondition.
+ -- Exclude explicitly discriminants (that can appear
+ -- in bounds of discriminated components).
if Is_Entity_Name (N) then
if Present (Entity (N))
Urefs.Append ((N, Full_E, Caller, Callee));
end Note_Uplevel_Ref;
+ -------------------------
+ -- Register_Subprogram --
+ -------------------------
+
+ procedure Register_Subprogram (E : Entity_Id; Bod : Node_Id) is
+ L : constant Nat := Get_Level (Subp, E);
+ begin
+ Subps.Append
+ ((Ent => E,
+ Bod => Bod,
+ Lev => L,
+ Reachable => False,
+ Uplevel_Ref => L,
+ Declares_AREC => False,
+ Uents => No_Elist,
+ Last => 0,
+ ARECnF => Empty,
+ ARECn => Empty,
+ ARECnT => Empty,
+ ARECnPT => Empty,
+ ARECnP => Empty,
+ ARECnU => Empty));
+ Set_Subps_Index (E, UI_From_Int (Subps.Last));
+ end Register_Subprogram;
+
-- Start of processing for Visit_Node
begin
- -- Record a call
+ case Nkind (N) is
- if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) then
+ -- Record a subprogram call
- -- We are only interested in direct calls, not indirect calls
- -- (where Name (N) is an explicit dereference) at least for now!
+ when N_Procedure_Call_Statement | N_Function_Call =>
+ -- We are only interested in direct calls, not indirect
+ -- calls (where Name (N) is an explicit dereference).
+ -- at least for now!
- if Nkind (Name (N)) in N_Has_Entity then
- Ent := Entity (Name (N));
+ if Nkind (Name (N)) in N_Has_Entity then
+ Ent := Entity (Name (N));
- -- We are only interested in calls to subprograms nested
- -- within Subp. Calls to Subp itself or to subprograms
- -- that are outside the nested structure do not affect us.
+ -- We are only interested in calls to subprograms nested
+ -- within Subp. Calls to Subp itself or to subprograms
+ -- outside the nested structure do not affect us.
- if Scope_Within (Ent, Subp) then
-
- -- Ignore calls to imported routines
+ if Scope_Within (Ent, Subp)
+ and then Is_Subprogram (Ent)
+ and then not Is_Imported (Ent)
+ then
+ Append_Unique_Call ((N, Current_Subprogram, Ent));
+ end if;
+ end if;
- if Is_Imported (Ent) then
- null;
+ -- For all calls where the formal is an unconstrained array
+ -- and the actual is constrained we need to check the bounds
+ -- for uplevel references.
- -- Here we have a call to keep and analyze
+ declare
+ Subp : Entity_Id;
+ Actual : Entity_Id;
+ Formal : Node_Id;
+ DT : Boolean := False;
+ begin
+ if Nkind (Name (N)) = N_Explicit_Dereference then
+ Subp := Etype (Name (N));
else
- -- Both caller and callee must be subprograms
+ Subp := Entity (Name (N));
+ end if;
- if Is_Subprogram (Ent) then
- Append_Unique_Call ((N, Current_Subprogram, Ent));
+ Actual := First_Actual (N);
+ Formal := First_Formal_With_Extras (Subp);
+ while Present (Actual) loop
+ if Is_Array_Type (Etype (Formal))
+ and then not Is_Constrained (Etype (Formal))
+ and then Is_Constrained (Etype (Actual))
+ then
+ Check_Static_Type (Etype (Actual), Empty, DT);
end if;
- end if;
- end if;
- end if;
- -- for all calls where the formal is an unconstrained array and
- -- the actual is constrained we need to check the bounds.
+ Next_Actual (Actual);
+ Next_Formal_With_Extras (Formal);
+ end loop;
+ end;
- declare
- Actual : Entity_Id;
- DT : Boolean := False;
- Formal : Node_Id;
- Subp : Entity_Id;
+ -- An At_End_Proc in a statement sequence indicates that
+ -- there's a call from the enclosing construct or block
+ -- to that subprogram. As above, the called entity must
+ -- be local and not imported.
- begin
- if Nkind (Name (N)) = N_Explicit_Dereference then
- Subp := Etype (Name (N));
- else
- Subp := Entity (Name (N));
+ when N_Handled_Sequence_Of_Statements =>
+ if Present (At_End_Proc (N))
+ and then Scope_Within (Entity (At_End_Proc (N)), Subp)
+ and then not Is_Imported (Entity (At_End_Proc (N)))
+ then
+ Append_Unique_Call ((N, Current_Subprogram,
+ Entity (At_End_Proc (N))));
end if;
- Actual := First_Actual (N);
- Formal := First_Formal_With_Extras (Subp);
- while Present (Actual) loop
- if Is_Array_Type (Etype (Formal))
- and then not Is_Constrained (Etype (Formal))
- and then Is_Constrained (Etype (Actual))
- then
- Check_Static_Type (Etype (Actual), Empty, DT);
- end if;
+ -- A 'Access reference is a (potential) call.
+ -- Other attributes require special handling.
- Next_Actual (Actual);
- Next_Formal_With_Extras (Formal);
- end loop;
- end;
+ when N_Attribute_Reference =>
+ declare
+ Attr : constant Attribute_Id :=
+ Get_Attribute_Id (Attribute_Name (N));
+ begin
+ case Attr is
+ when Attribute_Access
+ | Attribute_Unchecked_Access
+ | Attribute_Unrestricted_Access
+ =>
+ if Nkind (Prefix (N)) in N_Has_Entity then
+ Ent := Entity (Prefix (N));
+
+ -- We only need to examine calls to subprograms
+ -- nested within current Subp.
+
+ if Scope_Within (Ent, Subp) then
+ if Is_Imported (Ent) then
+ null;
+
+ elsif Is_Subprogram (Ent) then
+ Append_Unique_Call
+ ((N, Current_Subprogram, Ent));
+ end if;
+ end if;
+ end if;
- elsif Nkind (N) = N_Handled_Sequence_Of_Statements
- and then Present (At_End_Proc (N))
- then
- -- An At_End_Proc means there's a call from this block to that
- -- subprogram.
+ -- References to bounds can be uplevel references if
+ -- the type isn't static.
+
+ when Attribute_First
+ | Attribute_Last
+ | Attribute_Length
+ =>
+ -- Special-case attributes of objects whose bounds
+ -- may be uplevel references. More complex prefixes
+ -- handled during full traversal. Note that if the
+ -- nominal subtype of the prefix is unconstrained,
+ -- the bound must be obtained from the object, not
+ -- from the (possibly) uplevel reference.
+
+ if Is_Constrained (Etype (Prefix (N))) then
+ declare
+ DT : Boolean := False;
+ begin
+ Check_Static_Type (Etype (Prefix (N)),
+ Empty, DT);
+ end;
- Append_Unique_Call
- ((N, Current_Subprogram, Entity (At_End_Proc (N))));
+ return OK;
+ end if;
- -- Handle a 'Access as a (potential) call
+ when others =>
+ null;
+ end case;
+ end;
- elsif Nkind (N) = N_Attribute_Reference then
- declare
- Attr : constant Attribute_Id :=
- Get_Attribute_Id (Attribute_Name (N));
+ -- Indexed references can be uplevel if the type isn't static
+ -- and if the lower bound (or an inner bound for a multi-
+ -- dimensional array) is uplevel.
- begin
- case Attr is
- when Attribute_Access
- | Attribute_Unchecked_Access
- | Attribute_Unrestricted_Access
- =>
- if Nkind (Prefix (N)) in N_Has_Entity then
- Ent := Entity (Prefix (N));
-
- -- We are only interested in calls to subprograms
- -- nested within Subp.
-
- if Scope_Within (Ent, Subp) then
- if Is_Imported (Ent) then
- null;
-
- elsif Is_Subprogram (Ent) then
- Append_Unique_Call
- ((N, Current_Subprogram, Ent));
- end if;
- end if;
- end if;
+ when N_Indexed_Component | N_Slice =>
+ if Is_Constrained (Etype (Prefix (N))) then
+ declare
+ DT : Boolean := False;
+ begin
+ Check_Static_Type (Etype (Prefix (N)), Empty, DT);
+ end;
+ end if;
- -- References to bounds can be uplevel references if the
- -- type isn't static.
-
- when Attribute_First
- | Attribute_Last
- | Attribute_Length
- =>
- -- Special-case attributes of objects whose bounds
- -- may be uplevel references. More complex prefixes
- -- handled during full traversal. Note that if the
- -- nominal subtype of the prefix is unconstrained,
- -- the bound must be obtained from the object, not
- -- from the (possibly) uplevel reference.
-
- if Is_Constrained (Etype (Prefix (N))) then
- declare
- DT : Boolean := False;
- begin
- Check_Static_Type
- (Etype (Prefix (N)), Empty, DT);
- end;
+ -- A selected component can have an implicit up-level
+ -- reference due to the bounds of previous fields in the
+ -- record. We simplify the processing here by examining
+ -- all components of the record.
- return OK;
- end if;
+ -- Selected components appear as unit names and end labels
+ -- for child units. Prefixes of these nodes denote parent
+ -- units and carry no type information so they are skipped.
- when others =>
- null;
- end case;
- end;
+ when N_Selected_Component =>
+ if Present (Etype (Prefix (N))) then
+ declare
+ DT : Boolean := False;
+ begin
+ Check_Static_Type (Etype (Prefix (N)), Empty, DT);
+ end;
+ end if;
- -- Indexed references can be uplevel if the type isn't static and
- -- if the lower bound (or an inner bound for a multidimensional
- -- array) is uplevel.
+ -- Record a subprogram. We record a subprogram body that acts
+ -- as a spec. Otherwise we record a subprogram declaration,
+ -- providing that it has a corresponding body we can get hold
+ -- of. The case of no corresponding body being available is
+ -- ignored for now.
- elsif Nkind_In (N, N_Indexed_Component, N_Slice)
- and then Is_Constrained (Etype (Prefix (N)))
- then
- declare
- DT : Boolean := False;
- begin
- Check_Static_Type (Etype (Prefix (N)), Empty, DT);
- end;
+ when N_Subprogram_Body =>
+ Ent := Unique_Defining_Entity (N);
- -- A selected component can have an implicit up-level reference
- -- due to the bounds of previous fields in the record. We simplify
- -- the processing here by examining all components of the record.
+ -- Ignore generic subprogram
- -- Selected components appear as unit names and end labels for
- -- child units. The prefixes of these nodes denote parent units
- -- and carry no type information so they are skipped.
+ if Is_Generic_Subprogram (Ent) then
+ return Skip;
+ end if;
- elsif Nkind (N) = N_Selected_Component
- and then Present (Etype (Prefix (N)))
- then
- declare
- DT : Boolean := False;
- begin
- Check_Static_Type (Etype (Prefix (N)), Empty, DT);
- end;
+ -- Make new entry in subprogram table if not already made
+ Register_Subprogram (Ent, N);
- -- Record a subprogram. We record a subprogram body that acts as a
- -- spec. Otherwise we record a subprogram declaration, providing
- -- that it has a corresponding body we can get hold of. The case
- -- of no corresponding body being available is ignored for now.
+ -- We make a recursive call to scan the subprogram body, so
+ -- that we can save and restore Current_Subprogram.
- elsif Nkind (N) = N_Subprogram_Body then
- Ent := Unique_Defining_Entity (N);
+ declare
+ Save_CS : constant Entity_Id := Current_Subprogram;
+ Decl : Node_Id;
- -- Ignore generic subprogram
+ begin
+ Current_Subprogram := Ent;
- if Is_Generic_Subprogram (Ent) then
- return Skip;
- end if;
+ -- Scan declarations
- -- Make new entry in subprogram table if not already made
+ Decl := First (Declarations (N));
+ while Present (Decl) loop
+ Visit (Decl);
+ Next (Decl);
+ end loop;
- declare
- L : constant Nat := Get_Level (Subp, Ent);
- begin
- Subps.Append
- ((Ent => Ent,
- Bod => N,
- Lev => L,
- Reachable => False,
- Uplevel_Ref => L,
- Declares_AREC => False,
- Uents => No_Elist,
- Last => 0,
- ARECnF => Empty,
- ARECn => Empty,
- ARECnT => Empty,
- ARECnPT => Empty,
- ARECnP => Empty,
- ARECnU => Empty));
- Set_Subps_Index (Ent, UI_From_Int (Subps.Last));
- end;
+ -- Scan statements
- -- We make a recursive call to scan the subprogram body, so
- -- that we can save and restore Current_Subprogram.
+ Visit (Handled_Statement_Sequence (N));
- declare
- Save_CS : constant Entity_Id := Current_Subprogram;
- Decl : Node_Id;
+ -- Restore current subprogram setting
- begin
- Current_Subprogram := Ent;
+ Current_Subprogram := Save_CS;
+ end;
- -- Scan declarations
+ -- Now at this level, return skipping the subprogram body
+ -- descendants, since we already took care of them!
- Decl := First (Declarations (N));
- while Present (Decl) loop
- Visit (Decl);
- Next (Decl);
- end loop;
+ return Skip;
- -- Scan statements
+ -- If we have a body stub, visit the associated subunit,
+ -- which is a semantic descendant of the stub.
- Visit (Handled_Statement_Sequence (N));
+ when N_Body_Stub =>
+ Visit (Library_Unit (N));
- -- Restore current subprogram setting
+ -- A declaration of a wrapper package indicates a subprogram
+ -- instance for which there is no explicit body. Enter the
+ -- subprogram instance in the table.
- Current_Subprogram := Save_CS;
- end;
+ when N_Package_Declaration =>
+ if Is_Wrapper_Package (Defining_Entity (N)) then
+ Register_Subprogram
+ (Related_Instance (Defining_Entity (N)), Empty);
+ end if;
- -- Now at this level, return skipping the subprogram body
- -- descendants, since we already took care of them!
+ -- Skip generic declarations
+
+ when N_Generic_Declaration =>
+ return Skip;
- return Skip;
+ -- Skip generic package body
+
+ when N_Package_Body =>
+ if Present (Corresponding_Spec (N))
+ and then Ekind (Corresponding_Spec (N)) = E_Generic_Package
+ then
+ return Skip;
+ end if;
- -- Record an uplevel reference
+ -- Otherwise record an uplevel reference
- elsif Nkind (N) in N_Has_Entity and then Present (Entity (N)) then
- Ent := Entity (N);
+ when others =>
+ if
+ Nkind (N) in N_Has_Entity and then Present (Entity (N))
+ then
+ Ent := Entity (N);
- -- Only interested in entities declared within our nest
+ -- Only interested in entities declared within our nest
- if not Is_Library_Level_Entity (Ent)
- and then Scope_Within_Or_Same (Scope (Ent), Subp)
+ if not Is_Library_Level_Entity (Ent)
+ and then Scope_Within_Or_Same (Scope (Ent), Subp)
- -- Skip entities defined in inlined subprograms
+ -- Skip entities defined in inlined subprograms
- and then Chars (Enclosing_Subprogram (Ent)) /= Name_uParent
- and then
+ and then
+ Chars (Enclosing_Subprogram (Ent)) /= Name_uParent
- -- Constants and variables are potentially
- -- uplevel references to global declarations.
+ -- Constants and variables are potentially
+ -- uplevel references to global declarations.
- (Ekind_In (Ent, E_Constant, E_Variable)
+ and then
+ (Ekind_In (Ent, E_Constant, E_Variable)
-- Formals are interesting, but not if being used as mere
-- names of parameters for name notation calls.
- or else
- (Is_Formal (Ent)
- and then not
- (Nkind (Parent (N)) = N_Parameter_Association
- and then Selector_Name (Parent (N)) = N))
+ or else
+ (Is_Formal (Ent)
+ and then not
+ (Nkind (Parent (N)) = N_Parameter_Association
+ and then Selector_Name (Parent (N)) = N))
- -- Types other than known Is_Static types are interesting
+ -- Types other than known Is_Static types are
+ -- potentially interesting
- or else (Is_Type (Ent)
- and then not Is_Static_Type (Ent)))
- then
- -- Here we have a possible interesting uplevel reference
+ or else (Is_Type (Ent)
+ and then not Is_Static_Type (Ent)))
+ then
+ -- Here we have a potentially interesting uplevel
+ -- reference to examine.
- if Is_Type (Ent) then
- declare
- DT : Boolean := False;
+ if Is_Type (Ent) then
+ declare
+ DT : Boolean := False;
- begin
- Check_Static_Type (Ent, N, DT);
+ begin
+ Check_Static_Type (Ent, N, DT);
- if Is_Static_Type (Ent) then
- return OK;
+ if Is_Static_Type (Ent) then
+ return OK;
+ end if;
+ end;
end if;
- end;
- end if;
- Caller := Current_Subprogram;
- Callee := Enclosing_Subprogram (Ent);
+ Caller := Current_Subprogram;
+ Callee := Enclosing_Subprogram (Ent);
- if Callee /= Caller and then not Is_Static_Type (Ent) then
- Note_Uplevel_Ref (Ent, N, Caller, Callee);
+ if Callee /= Caller
+ and then not Is_Static_Type (Ent)
+ then
+ Note_Uplevel_Ref (Ent, N, Caller, Callee);
+ end if;
+ end if;
end if;
- end if;
-
- -- If we have a body stub, visit the associated subunit
-
- elsif Nkind (N) in N_Body_Stub then
- Visit (Library_Unit (N));
-
- -- Skip generic declarations
-
- elsif Nkind (N) in N_Generic_Declaration then
- return Skip;
-
- -- Skip generic package body
-
- elsif Nkind (N) = N_Package_Body
- and then Present (Corresponding_Spec (N))
- and then Ekind (Corresponding_Spec (N)) = E_Generic_Package
- then
- return Skip;
- end if;
+ end case;
-- Fall through to continue scanning children of this node
-- Rewrite declaration and body to null statements
- Spec := Corresponding_Spec (STJ.Bod);
+ -- A subprogram instantiation does not have an explicit
+ -- body. If unused, we could remove the corresponding
+ -- wrapper package and its body (TBD).
- if Present (Spec) then
- Decl := Parent (Declaration_Node (Spec));
- Rewrite (Decl, Make_Null_Statement (Sloc (Decl)));
- end if;
+ if Present (STJ.Bod) then
+ Spec := Corresponding_Spec (STJ.Bod);
- Rewrite (STJ.Bod, Make_Null_Statement (Sloc (STJ.Bod)));
+ if Present (Spec) then
+ Decl := Parent (Declaration_Node (Spec));
+ Rewrite (Decl, Make_Null_Statement (Sloc (Decl)));
+ end if;
+
+ Rewrite (STJ.Bod, Make_Null_Statement (Sloc (STJ.Bod)));
+ end if;
end if;
end;
end loop;
projects / gcc.git / commitdiff