Skip to content

R
riscv-gcc-1
Commit 13fa2acb by Arnaud Charlet
Options

[multiple changes] 

2014-10-23  Vincent Celier  <celier@adacore.com>

	* gnatls.adb: If --RTS= was not used, check if there is a default
	runtime. If there is none, in verbose mode, indicate that the
	default runtime is not available and show only the current
	directory in the source and the object search paths.

2014-10-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Process_Formals): A thunk procedure with a
	parameter of a limited view does not need a freeze node.

2014-10-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch7.adb (Analyze_Package_Body_Helper):
	The logic which hides local entities from external
	visibility is now contained in routine Hide_Public_Entities.
	(Hide_Public_Entities): New routine. Object and subprogram
	renamings are now hidden from external visibility the same way
	objects are.

2014-10-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute): The prefix of attribute Elaborated
	does not require freezing, in particular if it denotes a generic
	function.

From-SVN: r216585
parent b04d926e
Showing with 407 additions and 273 deletions
gcc/ada/ChangeLog
2014-10-23 Vincent Celier <celier@adacore.com>
* gnatls.adb: If --RTS= was not used, check if there is a default
runtime. If there is none, in verbose mode, indicate that the
default runtime is not available and show only the current
directory in the source and the object search paths.
2014-10-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Process_Formals): A thunk procedure with a
parameter of a limited view does not need a freeze node.
2014-10-23 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch7.adb (Analyze_Package_Body_Helper):
The logic which hides local entities from external
visibility is now contained in routine Hide_Public_Entities.
(Hide_Public_Entities): New routine. Object and subprogram
renamings are now hidden from external visibility the same way
objects are.
2014-10-23 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Analyze_Attribute): The prefix of attribute Elaborated
does not require freezing, in particular if it denotes a generic
function.
2014-10-23 Yannick Moy <moy@adacore.com>
* sem_prag.adb (Analyze_Pragma/Pragma_Inline & Pragma_Inline_Always):
......
gcc/ada/gnatls.adb
......@@ -65,6 +65,9 @@ procedure Gnatls is
No_Obj : aliased String := "<no_obj>";
No_Runtime : Boolean := False;
-- Set to True if there is no default runtime and --RTS= is not specified
type File_Status is (
OK, -- matching timestamp
Checksum_OK, -- only matching checksum
......@@ -1631,10 +1634,37 @@ begin
Osint.Add_Default_Search_Dirs;
-- If --RTS= is not specified, check if there is a default runtime
if RTS_Specified = null then
declare
Text : Source_Buffer_Ptr;
Hi : Source_Ptr;
begin
Name_Buffer (1 .. 10) := "system.ads";
Name_Len := 10;
Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text);
if Text = null then
No_Runtime := True;
end if;
end;
end if;
if Verbose_Mode then
Write_Eol;
Display_Version ("GNATLS", "1997");
Write_Eol;
if No_Runtime then
Write_Str
("Default runtime not available. Use --RTS= with a valid runtime");
Write_Eol;
Write_Eol;
end if;
Write_Str ("Source Search Path:");
Write_Eol;
......@@ -1643,14 +1673,15 @@ begin
if Dir_In_Src_Search_Path (J)'Length = 0 then
Write_Str ("<Current_Directory>");
else
Write_Eol;
elsif not No_Runtime then
Write_Str
(Normalize
(To_Host_Dir_Spec
(Dir_In_Src_Search_Path (J).all, True).all));
end if;
Write_Eol;
end if;
end loop;
Write_Eol;
......@@ -1663,14 +1694,15 @@ begin
if Dir_In_Obj_Search_Path (J)'Length = 0 then
Write_Str ("<Current_Directory>");
else
Write_Eol;
elsif not No_Runtime then
Write_Str
(Normalize
(To_Host_Dir_Spec
(Dir_In_Obj_Search_Path (J).all, True).all));
end if;
Write_Eol;
end if;
end loop;
Write_Eol;
......
gcc/ada/sem_attr.adb
......@@ -11164,7 +11164,16 @@ package body Sem_Attr is
-- Normally the Freezing is done by Resolve but sometimes the Prefix
-- is not resolved, in which case the freezing must be done now.
-- For an elaboration check on a subprogram, we do not freeze its type.
-- It may be declared in an unrelated scope, in particular in the case
-- of a generic function whose type may remain unelaborated.
if Attr_Id = Attribute_Elaborated then
null;
else
Freeze_Expression (P);
end if;
-- Finally perform static evaluation on the attribute reference
......
gcc/ada/sem_ch6.adb
......@@ -9946,9 +9946,11 @@ package body Sem_Ch6 is
-- (Note that the same is done for controlling access
-- parameter cases in function Access_Definition.)
if not Is_Thunk (Current_Scope) then
Set_Has_Delayed_Freeze (Current_Scope);
end if;
end if;
end if;
-- Special handling of Value_Type for CIL case
......
gcc/ada/sem_ch7.adb
......@@ -220,12 +220,12 @@ package body Sem_Ch7 is
---------------------------------
procedure Analyze_Package_Body_Helper (N : Node_Id) is
HSS : Node_Id;
Body_Id : Entity_Id;
Spec_Id : Entity_Id;
Last_Spec_Entity : Entity_Id;
New_N : Node_Id;
Pack_Decl : Node_Id;
procedure Hide_Public_Entities (Decls : List_Id);
-- Attempt to hide all public entities found in declarative list Decls
-- by resetting their Is_Public flag to False depending on whether the
-- entities are not referenced by inlined or generic bodies. This kind
-- of processing is a conservative approximation and may still leave
-- certain entities externally visible.
procedure Install_Composite_Operations (P : Entity_Id);
-- Composite types declared in the current scope may depend on types
......@@ -233,6 +233,310 @@ package body Sem_Ch7 is
-- is now in scope. Indicate that the corresponding operations on the
-- composite type are available.
--------------------------
-- Hide_Public_Entities --
--------------------------
procedure Hide_Public_Entities (Decls : List_Id) is
function Contains_Subp_Or_Const_Refs (N : Node_Id) return Boolean;
-- Subsidiary to routine Has_Referencer. Determine whether a node
-- contains a reference to a subprogram or a non-static constant.
-- WARNING: this is a very expensive routine as it performs a full
-- tree traversal.
function Has_Referencer
(Decls : List_Id;
Top_Level : Boolean := False) return Boolean;
-- A "referencer" is a construct which may reference a previous
-- declaration. Examine all declarations in list Decls in reverse
-- and determine whether once such referencer exists. All entities
-- in the range Last (Decls) .. Referencer are hidden from external
-- visibility.
---------------------------------
-- Contains_Subp_Or_Const_Refs --
---------------------------------
function Contains_Subp_Or_Const_Refs (N : Node_Id) return Boolean is
Reference_Seen : Boolean := False;
function Is_Subp_Or_Const_Ref
(N : Node_Id) return Traverse_Result;
-- Determine whether a node denotes a reference to a subprogram or
-- a non-static constant.
--------------------------
-- Is_Subp_Or_Const_Ref --
--------------------------
function Is_Subp_Or_Const_Ref
(N : Node_Id) return Traverse_Result
is
Val : Node_Id;
begin
-- Detect a reference of the form
-- Subp_Call
if Nkind (N) in N_Subprogram_Call
and then Is_Entity_Name (Name (N))
then
Reference_Seen := True;
return Abandon;
-- Detect a reference of the form
-- Subp'Some_Attribute
elsif Nkind (N) = N_Attribute_Reference
and then Is_Entity_Name (Prefix (N))
and then Is_Subprogram (Entity (Prefix (N)))
then
Reference_Seen := True;
return Abandon;
-- Detect the use of a non-static constant
elsif Is_Entity_Name (N)
and then Present (Entity (N))
and then Ekind (Entity (N)) = E_Constant
then
Val := Constant_Value (Entity (N));
if Present (Val)
and then not Compile_Time_Known_Value (Val)
then
Reference_Seen := True;
return Abandon;
end if;
end if;
return OK;
end Is_Subp_Or_Const_Ref;
procedure Find_Subp_Or_Const_Ref is
new Traverse_Proc (Is_Subp_Or_Const_Ref);
-- Start of processing for Contains_Subp_Or_Const_Refs
begin
Find_Subp_Or_Const_Ref (N);
return Reference_Seen;
end Contains_Subp_Or_Const_Refs;
--------------------
-- Has_Referencer --
--------------------
function Has_Referencer
(Decls : List_Id;
Top_Level : Boolean := False) return Boolean
is
Decl : Node_Id;
Decl_Id : Entity_Id;
Spec : Node_Id;
Has_Non_Subp_Const_Referencer : Boolean := False;
-- Flag set for inlined subprogram bodies that do not contain
-- references to other subprograms or non-static constants.
begin
if No (Decls) then
return False;
end if;
-- Examine all declarations in reverse order, hiding all entities
-- from external visibility until a referencer has been found. The
-- algorithm recurses into nested packages.
Decl := Last (Decls);
while Present (Decl) loop
-- A stub is always considered a referencer
if Nkind (Decl) in N_Body_Stub then
return True;
-- Package declaration
elsif Nkind (Decl) = N_Package_Declaration
and then not Has_Non_Subp_Const_Referencer
then
Spec := Specification (Decl);
-- Inspect the declarations of a non-generic package to try
-- and hide more entities from external visibility.
if not Is_Generic_Unit (Defining_Entity (Spec)) then
if Has_Referencer (Private_Declarations (Spec))
or else Has_Referencer (Visible_Declarations (Spec))
then
return True;
end if;
end if;
-- Package body
elsif Nkind (Decl) = N_Package_Body
and then Present (Corresponding_Spec (Decl))
then
Decl_Id := Corresponding_Spec (Decl);
-- A generic package body is a referencer. It would seem
-- that we only have to consider generics that can be
-- exported, i.e. where the corresponding spec is the
-- spec of the current package, but because of nested
-- instantiations, a fully private generic body may export
-- other private body entities. Furthermore, regardless of
-- whether there was a previous inlined subprogram, (an
-- instantiation of) the generic package may reference any
-- entity declared before it.
if Is_Generic_Unit (Decl_Id) then
return True;
-- Inspect the declarations of a non-generic package body to
-- try and hide more entities from external visibility.
elsif not Has_Non_Subp_Const_Referencer
and then Has_Referencer (Declarations (Decl))
then
return True;
end if;
-- Subprogram body
elsif Nkind (Decl) = N_Subprogram_Body then
if Present (Corresponding_Spec (Decl)) then
Decl_Id := Corresponding_Spec (Decl);
-- A generic subprogram body acts as a referencer
if Is_Generic_Unit (Decl_Id) then
return True;
end if;
-- An inlined subprogram body acts as a referencer
if Is_Inlined (Decl_Id)
or else Has_Pragma_Inline (Decl_Id)
then
-- Inspect the statements of the subprogram body
-- to determine whether the body references other
-- subprograms and/or non-static constants.
if Top_Level
and then not Contains_Subp_Or_Const_Refs (Decl)
then
Has_Non_Subp_Const_Referencer := True;
else
return True;
end if;
end if;
-- Otherwise this is a stand alone subprogram body
else
Decl_Id := Defining_Entity (Decl);
-- An inlined body acts as a referencer. Note that an
-- inlined subprogram remains Is_Public as gigi requires
-- the flag to be set.
-- Note that we test Has_Pragma_Inline here rather than
-- Is_Inlined. We are compiling this for a client, and
-- it is the client who will decide if actual inlining
-- should occur, so we need to assume that the procedure
-- could be inlined for the purpose of accessing global
-- entities.
if Has_Pragma_Inline (Decl_Id) then
if Top_Level
and then not Contains_Subp_Or_Const_Refs (Decl)
then
Has_Non_Subp_Const_Referencer := True;
else
return True;
end if;
else
Set_Is_Public (Decl_Id, False);
end if;
end if;
-- Exceptions, objects and renamings do not need to be public
-- if they are not followed by a construct which can reference
-- and export them. The Is_Public flag is reset on top level
-- entities only as anything nested is local to its context.
elsif Nkind_In (Decl, N_Exception_Declaration,
N_Object_Declaration,
N_Object_Renaming_Declaration,
N_Subprogram_Declaration,
N_Subprogram_Renaming_Declaration)
then
Decl_Id := Defining_Entity (Decl);
if Top_Level
and then not Is_Imported (Decl_Id)
and then not Is_Exported (Decl_Id)
and then No (Interface_Name (Decl_Id))
and then
(not Has_Non_Subp_Const_Referencer
or else Nkind (Decl) = N_Subprogram_Declaration)
then
Set_Is_Public (Decl_Id, False);
end if;
end if;
Prev (Decl);
end loop;
return Has_Non_Subp_Const_Referencer;
end Has_Referencer;
-- Local variables
Discard : Boolean := True;
pragma Unreferenced (Discard);
-- Start of processing for Hide_Public_Entities
begin
-- The algorithm examines the top level declarations of a package
-- body in reverse looking for a construct that may export entities
-- declared prior to it. If such a scenario is encountered, then all
-- entities in the range Last (Decls) .. construct are hidden from
-- external visibility. Consider:
-- package Pack is
-- generic
-- package Gen is
-- end Gen;
-- end Pack;
-- package body Pack is
-- External_Obj : ...; -- (1)
-- package body Gen is -- (2)
-- ... External_Obj ... -- (3)
-- end Gen;
-- Local_Obj : ...; -- (4)
-- end Pack;
-- In this example Local_Obj (4) must not be externally visible as
-- it cannot be exported by anything in Pack. The body of generic
-- package Gen (2) on the other hand acts as a "referencer" and may
-- export anything declared before it. Since the compiler does not
-- perform flow analysis, it is not possible to determine precisely
-- which entities will be exported when Gen is instantiated. In the
-- example above External_Obj (1) is exported at (3), but this may
-- not always be the case. The algorithm takes a conservative stance
-- and leaves entity External_Obj public.
Discard := Has_Referencer (Decls, Top_Level => True);
end Hide_Public_Entities;
----------------------------------
-- Install_Composite_Operations --
----------------------------------
......@@ -256,6 +560,15 @@ package body Sem_Ch7 is
end loop;
end Install_Composite_Operations;
-- Local variables
Body_Id : Entity_Id;
HSS : Node_Id;
Last_Spec_Entity : Entity_Id;
New_N : Node_Id;
Pack_Decl : Node_Id;
Spec_Id : Entity_Id;
-- Start of processing for Analyze_Package_Body_Helper
begin
......@@ -557,272 +870,23 @@ package body Sem_Ch7 is
Check_References (Spec_Id);
end if;
-- The processing so far has made all entities of the package body
-- public (i.e. externally visible to the linker). This is in general
-- necessary, since inlined or generic bodies, for which code is
-- generated in other units, may need to see these entities. The
-- following loop runs backwards from the end of the entities of the
-- package body making these entities invisible until we reach a
-- referencer, i.e. a declaration that could reference a previous
-- declaration, a generic body or an inlined body, or a stub (which may
-- contain either of these). This is of course an approximation, but it
-- is conservative and definitely correct.
-- At this point all entities of the package body are externally visible
-- to the linker as their Is_Public flag is set to True. This proactive
-- approach is necessary because an inlined or a generic body for which
-- code is generated in other units may need to see these entities. Cut
-- down the number of global symbols that do not neet public visibility
-- as this has two beneficial effects:
-- (1) It makes the compilation process more efficient.
-- (2) It gives the code generatormore freedom to optimize within each
-- unit, especially subprograms.
-- We only do this at the outer (library) level non-generic packages.
-- The reason is simply to cut down on the number of global symbols
-- generated, which has a double effect: (1) to make the compilation
-- process more efficient and (2) to give the code generator more
-- freedom to optimize within each unit, especially subprograms.
-- This is done only for top level library packages or child units as
-- the algorithm does a top down traversal of the package body.
if (Scope (Spec_Id) = Standard_Standard or else Is_Child_Unit (Spec_Id))
and then not Is_Generic_Unit (Spec_Id)
and then Present (Declarations (N))
then
Make_Non_Public_Where_Possible : declare
function Has_Referencer
(L : List_Id;
Outer : Boolean) return Boolean;
-- Traverse given list of declarations in reverse order. Return
-- True if a referencer is present. Return False if none is found.
--
-- The Outer parameter is True for the outer level call and False
-- for inner level calls for nested packages. If Outer is True,
-- then any entities up to the point of hitting a referencer get
-- their Is_Public flag cleared, so that the entities will be
-- treated as static entities in the C sense, and need not have
-- fully qualified names. Furthermore, if the referencer is an
-- inlined subprogram that doesn't reference other subprograms,
-- we keep clearing the Is_Public flag on subprograms. For inner
-- levels, we need all names to be fully qualified to deal with
-- the same name appearing in parallel packages (right now this
-- is tied to their being external).
--------------------
-- Has_Referencer --
--------------------
function Has_Referencer
(L : List_Id;
Outer : Boolean) return Boolean
is
Has_Referencer_Except_For_Subprograms : Boolean := False;
D : Node_Id;
E : Entity_Id;
K : Node_Kind;
S : Entity_Id;
function Check_Subprogram_Ref (N : Node_Id)
return Traverse_Result;
-- Look for references to subprograms
--------------------------
-- Check_Subprogram_Ref --
--------------------------
function Check_Subprogram_Ref (N : Node_Id)
return Traverse_Result
is
V : Node_Id;
begin
-- Check name of procedure or function calls
if Nkind (N) in N_Subprogram_Call
and then Is_Entity_Name (Name (N))
then
return Abandon;
end if;
-- Check prefix of attribute references
if Nkind (N) = N_Attribute_Reference
and then Is_Entity_Name (Prefix (N))
and then Present (Entity (Prefix (N)))
and then Ekind (Entity (Prefix (N))) in Subprogram_Kind
then
return Abandon;
end if;
-- Check value of constants
if Nkind (N) = N_Identifier
and then Present (Entity (N))
and then Ekind (Entity (N)) = E_Constant
then
V := Constant_Value (Entity (N));
if Present (V)
and then not Compile_Time_Known_Value_Or_Aggr (V)
then
return Abandon;
end if;
end if;
return OK;
end Check_Subprogram_Ref;
function Check_Subprogram_Refs is
new Traverse_Func (Check_Subprogram_Ref);
-- Start of processing for Has_Referencer
begin
if No (L) then
return False;
end if;
D := Last (L);
while Present (D) loop
K := Nkind (D);
if K in N_Body_Stub then
return True;
-- Processing for subprogram bodies
elsif K = N_Subprogram_Body then
if Acts_As_Spec (D) then
E := Defining_Entity (D);
-- An inlined body acts as a referencer. Note also
-- that we never reset Is_Public for an inlined
-- subprogram. Gigi requires Is_Public to be set.
-- Note that we test Has_Pragma_Inline here rather
-- than Is_Inlined. We are compiling this for a
-- client, and it is the client who will decide if
-- actual inlining should occur, so we need to assume
-- that the procedure could be inlined for the purpose
-- of accessing global entities.
if Has_Pragma_Inline (E) then
if Outer and then Check_Subprogram_Refs (D) = OK
then
Has_Referencer_Except_For_Subprograms := True;
else
return True;
end if;
else
Set_Is_Public (E, False);
end if;
else
E := Corresponding_Spec (D);
if Present (E) then
-- A generic subprogram body acts as a referencer
if Is_Generic_Unit (E) then
return True;
end if;
if Has_Pragma_Inline (E) or else Is_Inlined (E) then
if Outer and then Check_Subprogram_Refs (D) = OK
then
Has_Referencer_Except_For_Subprograms := True;
else
return True;
end if;
end if;
end if;
end if;
-- Processing for package bodies
elsif K = N_Package_Body
and then Present (Corresponding_Spec (D))
then
E := Corresponding_Spec (D);
-- Generic package body is a referencer. It would seem
-- that we only have to consider generics that can be
-- exported, i.e. where the corresponding spec is the
-- spec of the current package, but because of nested
-- instantiations, a fully private generic body may
-- export other private body entities. Furthermore,
-- regardless of whether there was a previous inlined
-- subprogram, (an instantiation of) the generic package
-- may reference any entity declared before it.
if Is_Generic_Unit (E) then
return True;
-- For non-generic package body, recurse into body unless
-- this is an instance, we ignore instances since they
-- cannot have references that affect outer entities.
elsif not Is_Generic_Instance (E)
and then not Has_Referencer_Except_For_Subprograms
then
if Has_Referencer
(Declarations (D), Outer => False)
then
return True;
end if;
end if;
-- Processing for package specs, recurse into declarations.
-- Again we skip this for the case of generic instances.
elsif K = N_Package_Declaration
and then not Has_Referencer_Except_For_Subprograms
then
S := Specification (D);
if not Is_Generic_Unit (Defining_Entity (S)) then
if Has_Referencer
(Private_Declarations (S), Outer => False)
then
return True;
elsif Has_Referencer
(Visible_Declarations (S), Outer => False)
then
return True;
end if;
end if;
-- Objects and exceptions need not be public if we have not
-- encountered a referencer so far. We only reset the flag
-- for outer level entities that are not imported/exported,
-- and which have no interface name.
elsif Nkind_In (K, N_Object_Declaration,
N_Exception_Declaration,
N_Subprogram_Declaration)
then
E := Defining_Entity (D);
if Outer
and then (not Has_Referencer_Except_For_Subprograms
or else K = N_Subprogram_Declaration)
and then not Is_Imported (E)
and then not Is_Exported (E)
and then No (Interface_Name (E))
then
Set_Is_Public (E, False);
end if;
end if;
Prev (D);
end loop;
return Has_Referencer_Except_For_Subprograms;
end Has_Referencer;
-- Start of processing for Make_Non_Public_Where_Possible
begin
declare
Discard : Boolean;
pragma Warnings (Off, Discard);
begin
Discard := Has_Referencer (Declarations (N), Outer => True);
end;
end Make_Non_Public_Where_Possible;
Hide_Public_Entities (Declarations (N));
end if;
-- If expander is not active, then here is where we turn off the
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment