Skip to content

R
riscv-gcc-1
Commit 02886c2e by Arnaud Charlet
Options

2015-10-26 Joel Brobecker <brobecker@adacore.com brobecker> 

	* adaint.c (__gnat_lwp_self): Replace current implementation re-using
	the Linux one, which uses an __NR_gettid syscall rather than
	pthread_self.

2015-10-26  Arnaud Charlet  <charlet@adacore.com>

	* sinfo.ads, exp_ch3.adb (Build_Array_Init_Proc,
	Build_Record_Init_Proc): Do not inline init procs when
	Modify_Tree_For_C is True.

2015-10-26  Bob Duff  <duff@adacore.com>

	* errout.ads: Minor comment fix.
	* einfo.ads: Minor style fix.

2015-10-26  Bob Duff  <duff@adacore.com>

	* sem_ch3.adb (Derive_Interface_Subprogram): Fix
	Is_Abstract_Subprogram, which might have been calculated
	incorrectly, because we're passing Ultimate_Alias (Subp) (and
	its dispatching type) to Derive_Subprogram, instead of the true
	parent subprogram and type.

2015-10-26  Bob Duff  <duff@adacore.com>

	* sem_ch13.adb (Check_Iterator_Functions): When
	printing the "default iterator must be unique" error message,
	also print references to the places where the duplicates are
	declared. This makes the message clearer.

From-SVN: r229320
parent 51022ff7
Showing with 137 additions and 90 deletions
gcc/ada/ChangeLog
2015-10-26 Joel Brobecker <brobecker@adacore.com brobecker>
* adaint.c (__gnat_lwp_self): Replace current implementation re-using
the Linux one, which uses an __NR_gettid syscall rather than
pthread_self.
2015-10-26 Arnaud Charlet <charlet@adacore.com>
* sinfo.ads, exp_ch3.adb (Build_Array_Init_Proc,
Build_Record_Init_Proc): Do not inline init procs when
Modify_Tree_For_C is True.
2015-10-26 Bob Duff <duff@adacore.com>
* errout.ads: Minor comment fix.
* einfo.ads: Minor style fix.
2015-10-26 Bob Duff <duff@adacore.com>
* sem_ch3.adb (Derive_Interface_Subprogram): Fix
Is_Abstract_Subprogram, which might have been calculated
incorrectly, because we're passing Ultimate_Alias (Subp) (and
its dispatching type) to Derive_Subprogram, instead of the true
parent subprogram and type.
2015-10-26 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Check_Iterator_Functions): When
printing the "default iterator must be unique" error message,
also print references to the places where the duplicates are
declared. This makes the message clearer.
2015-10-26 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Analyze_Formal_Package_Declaration): Do not set
......
gcc/ada/adaint.c
......@@ -3061,17 +3061,7 @@ __gnat_sals_init_using_constructors (void)
#endif
}
#if defined (__ANDROID__)
#include <pthread.h>
void *
__gnat_lwp_self (void)
{
return (void *) pthread_self ();
}
#elif defined (__linux__)
#if defined (__linux__) || defined (__ANDROID__)
/* There is no function in the glibc to retrieve the LWP of the current
thread. We need to do a system call in order to retrieve this
information. */
......@@ -3081,7 +3071,9 @@ __gnat_lwp_self (void)
{
return (void *) syscall (__NR_gettid);
}
#endif
#if defined (__linux__)
#include <sched.h>
/* glibc versions earlier than 2.7 do not define the routines to handle
......
gcc/ada/einfo.ads
......@@ -704,6 +704,12 @@ package Einfo is
-- bodies. Set if the entity contains any ignored Ghost code in the form
-- of declaration, procedure call, assignment statement or pragma.
-- Contract (Node34)
-- Defined in constant, entry, entry family, [generic] package, package
-- body, [generic] subprogram, subprogram body, and variable entities.
-- Points to the contract of the entity, holding various assertion items
-- and data classifiers.
-- Corresponding_Concurrent_Type (Node18)
-- Defined in record types that are constructed by the expander to
-- represent task and protected types (Is_Concurrent_Record_Type flag
......@@ -1123,12 +1129,6 @@ package Einfo is
-- accept statement for a member of the family, and in the prefix of
-- 'COUNT when it applies to a family member.
-- Contract (Node34)
-- Defined in constant, entry, entry family, [generic] package, package
-- body, [generic] subprogram, subprogram body, and variable entities.
-- Points to the contract of the entity, holding various assertion items
-- and data classifiers.
-- Entry_Parameters_Type (Node15)
-- Defined in entries. Points to the access-to-record type that is
-- constructed by the expander to hold a reference to the parameter
......@@ -1519,16 +1519,16 @@ package Einfo is
-- Defined in enumeration types. Set if the type as a representation
-- clause whose entries are successive integers.
-- Has_Controlling_Result (Flag98)
-- Defined in E_Function entities. Set if the function is a primitive
-- function of a tagged type which can dispatch on result.
-- Has_Controlled_Component (Flag43) [base type only]
-- Defined in all type and subtype entities. Set only for composite type
-- entities which contain a component that either is a controlled type,
-- or itself contains controlled component (i.e. either Is_Controlled or
-- Has_Controlled_Component is set for at least one component).
-- Has_Controlling_Result (Flag98)
-- Defined in E_Function entities. Set if the function is a primitive
-- function of a tagged type which can dispatch on result.
-- Has_Convention_Pragma (Flag119)
-- Defined in all entities. Set for an entity for which a valid pragma
-- Convention, Import, or Export has been given. Used to prevent more
......@@ -1836,19 +1836,19 @@ package Einfo is
-- valid pragma Pack was given for the type. Note that this flag is not
-- inherited by derived type. See also the Is_Packed flag.
-- Has_Pragma_Preelab_Init (Flag221)
-- Defined in type and subtype entities. If set indicates that a valid
-- pragma Preelaborable_Initialization applies to the type.
-- Has_Pragma_Pure (Flag203)
-- Defined in all entities. If set, indicates that a valid pragma Pure
-- was given for the entity. In some cases, we need to test whether
-- Is_Pure was explicitly set using this pragma.
-- Has_Pragma_Preelab_Init (Flag221)
-- Defined in type and subtype entities. If set indicates that a valid
-- pragma Preelaborable_Initialization applies to the type.
-- Has_Pragma_Pure_Function (Flag179)
-- Defined in all entities. If set, indicates that a valid pragma
-- Pure_Function was given for the entity. In some cases, we need to
-- know that Is_Pure was explicitly set using this pragma. We also set
-- Pure_Function was given for the entity. In some cases, we need to test
-- whether Is_Pure was explicitly set using this pragma. We also set
-- this flag for some internal entities that we know should be treated
-- as pure for optimization purposes.
......@@ -2209,6 +2209,13 @@ package Einfo is
-- carry the keyword aliased, and on record components that have the
-- keyword. For Ada 2012, also applies to formal parameters.
-- Is_Array_Type (synthesized)
-- Applies to all entities, true for array types and subtypes
-- Is_Asynchronous (Flag81)
-- Defined in all type entities and in procedure entities. Set
-- if a pragma Asynchronous applies to the entity.
-- Is_Atomic (Flag85)
-- Defined in all type entities, and also in constants, components, and
-- variables. Set if a pragma Atomic or Shared applies to the entity.
......@@ -2223,13 +2230,6 @@ package Einfo is
-- usage. In the case of private and incomplete types, the predicate
-- applies to both the partial view and the full view.
-- Is_Array_Type (synthesized)
-- Applies to all entities, true for array types and subtypes
-- Is_Asynchronous (Flag81)
-- Defined in all type entities and in procedure entities. Set
-- if a pragma Asynchronous applies to the entity.
-- Is_Base_Type (synthesized)
-- Applies to type and subtype entities. True if entity is a base type
......@@ -2266,14 +2266,14 @@ package Einfo is
-- Defined in all entities. Set only for defining entities of program
-- units that are child units (but False for subunits).
-- Is_Class_Wide_Type (synthesized)
-- Applies to all entities, true for class wide types and subtypes
-- Is_Class_Wide_Equivalent_Type (Flag35)
-- Defined in record types and subtypes. Set to True, if the type acts
-- as a class-wide equivalent type, i.e. the Equivalent_Type field of
-- some class-wide subtype entity references this record type.
-- Is_Class_Wide_Type (synthesized)
-- Applies to all entities, true for class wide types and subtypes
-- Is_Compilation_Unit (Flag149)
-- Defined in all entities. Set if the entity is a package or subprogram
-- entity for a compilation unit other than a subunit (since we treat
......@@ -2360,13 +2360,13 @@ package Einfo is
-- Defined in all entities. True if the entity is type System.Address,
-- or (recursively) a subtype or derived type of System.Address.
-- Is_Discrete_Type (synthesized)
-- Applies to all entities, true for all discrete types and subtypes
-- Is_Discrete_Or_Fixed_Point_Type (synthesized)
-- Applies to all entities, true for all discrete types and subtypes
-- and all fixed-point types and subtypes.
-- Is_Discrete_Type (synthesized)
-- Applies to all entities, true for all discrete types and subtypes
-- Is_Discrim_SO_Function (Flag176)
-- Defined in all entities. Set only in E_Function entities that Layout
-- creates to compute discriminant-dependent dynamic size/offset values.
......@@ -2404,9 +2404,6 @@ package Einfo is
-- of pragma Eliminate. Also used to mark subprogram entities whose
-- declaration and body are within unreachable code that is removed.
-- Is_Enumeration_Type (synthesized)
-- Defined in all entities, true for enumeration types and subtypes
-- Is_Entry (synthesized)
-- Applies to all entities, True only for entry and entry family
-- entities and False for all other entity kinds.
......@@ -2416,6 +2413,9 @@ package Einfo is
-- be in, in-out or out parameters). This flag is used to speed up the
-- test for the need to replace references in Exp_Ch2.
-- Is_Enumeration_Type (synthesized)
-- Defined in all entities, true for enumeration types and subtypes
-- Is_Exported (Flag99)
-- Defined in all entities. Set if the entity is exported. For now we
-- only allow the export of constants, exceptions, functions, procedures
......@@ -2807,14 +2807,14 @@ package Einfo is
-- Applies to all entities, true for ordinary fixed point types and
-- subtypes.
-- Is_Package_Or_Generic_Package (synthesized)
-- Applies to all entities. True for packages and generic packages.
-- False for all other entities.
-- Is_Package_Body_Entity (Flag160)
-- Defined in all entities. Set for entities defined at the top level
-- of a package body. Used to control externally generated names.
-- Is_Package_Or_Generic_Package (synthesized)
-- Applies to all entities. True for packages and generic packages.
-- False for all other entities.
-- Is_Packed (Flag51) [implementation base type only]
-- Defined in all type entities. This flag is set only for record and
-- array types which have a packed representation. There are three
......@@ -2946,6 +2946,10 @@ package Einfo is
-- Defined in types that are interfaces. True if interface is declared
-- protected, or is derived from protected interfaces.
-- Is_Protected_Record_Type (synthesized)
-- Applies to all entities, true if Is_Concurrent_Record_Type is true and
-- Corresponding_Concurrent_Type is a protected type.
-- Is_Protected_Type (synthesized)
-- Applies to all entities, true for protected types and subtypes
......@@ -2956,10 +2960,6 @@ package Einfo is
-- example in the case of a variable name, then the backend will generate
-- an appropriate external name for use by the linker.
-- Is_Protected_Record_Type (synthesized)
-- Applies to all entities, true if Is_Concurrent_Record_Type is true and
-- Corresponding_Concurrent_Type is a protected type.
-- Is_Pure (Flag44)
-- Defined in all entities. Set in all entities of a unit to which a
-- pragma Pure is applied except for non-intrinsic imported subprograms,
......@@ -3772,16 +3772,16 @@ package Einfo is
-- in the shadow entity, it points to the proper location in which to
-- restore the private view saved in the shadow.
-- Protected_Body_Subprogram (Node11)
-- Defined in protected operations. References the entity for the
-- subprogram which implements the body of the operation.
-- Protected_Formal (Node22)
-- Defined in formal parameters (in, in out and out parameters). Used
-- only for formals of protected operations. References corresponding
-- formal parameter in the unprotected version of the operation that
-- is created during expansion.
-- Protected_Body_Subprogram (Node11)
-- Defined in protected operations. References the entity for the
-- subprogram which implements the body of the operation.
-- Protection_Object (Node23)
-- Applies to protected entries, entry families and subprograms. Denotes
-- the entity which is used to rename the _object component of protected
......@@ -3902,13 +3902,6 @@ package Einfo is
-- is True only for implicitly declared subprograms; it is not set on the
-- parent type's subprogram. See also Is_Abstract_Subprogram.
-- Return_Present (Flag54)
-- Defined in function and generic function entities. Set if the
-- function contains a return statement (used for error checking).
-- This flag can also be set in procedure and generic procedure
-- entities (for convenience in setting it), but is only tested
-- for the function case.
-- Return_Applies_To (Node8)
-- Defined in E_Return_Statement. Points to the entity representing
-- the construct to which the return statement applies, as defined in
......@@ -3916,6 +3909,13 @@ package Einfo is
-- extended_return_statement applies to the extended_return_statement,
-- even though it causes the whole function to return.
-- Return_Present (Flag54)
-- Defined in function and generic function entities. Set if the
-- function contains a return statement (used for error checking).
-- This flag can also be set in procedure and generic procedure
-- entities (for convenience in setting it), but is only tested
-- for the function case.
-- Returns_By_Ref (Flag90)
-- Defined in function entities. Set if the function returns the result
-- by reference, either because its return type is a by-reference-type
......@@ -4127,6 +4127,21 @@ package Einfo is
-- are fully analyzed and typed with the base type of the subtype. Note
-- that all entries are static and have values within the subtype range.
-- Static_Elaboration_Desired (Flag77)
-- Defined in library-level packages. Set by the pragma of the same
-- name, to indicate that static initialization must be attempted for
-- all types declared in the package, and that a warning must be emitted
-- for those types to which static initialization is not available.
-- Static_Initialization (Node30)
-- Defined in initialization procedures for types whose objects can be
-- initialized statically. The value of this attribute is a positional
-- aggregate whose components are compile-time static values. Used
-- when available in object declarations to eliminate the call to the
-- initialization procedure, and to minimize elaboration code. Note:
-- This attribute uses the same field as Overridden_Operation, which is
-- irrelevant in init_procs.
-- Static_Real_Or_String_Predicate (Node25)
-- Defined in real types/subtypes with static predicates (with the two
-- flags Has_Predicates and Has_Static_Predicate set). Set if the type
......@@ -4156,21 +4171,6 @@ package Einfo is
-- or the declaration of a "hook" object.
-- In which case is it a flag, or a hook object???
-- Static_Elaboration_Desired (Flag77)
-- Defined in library-level packages. Set by the pragma of the same
-- name, to indicate that static initialization must be attempted for
-- all types declared in the package, and that a warning must be emitted
-- for those types to which static initialization is not available.
-- Static_Initialization (Node30)
-- Defined in initialization procedures for types whose objects can be
-- initialized statically. The value of this attribute is a positional
-- aggregate whose components are compile-time static values. Used
-- when available in object declarations to eliminate the call to the
-- initialization procedure, and to minimize elaboration code. Note:
-- This attribute uses the same field as Overridden_Operation, which is
-- irrelevant in init_procs.
-- Storage_Size_Variable (Node26) [implementation base type only]
-- Defined in access types and task type entities. This flag is set
-- if a valid and effective pragma Storage_Size applies to the base
......
gcc/ada/errout.ads
......@@ -111,9 +111,6 @@ package Errout is
-- This normal suppression action may be overridden in cases 2-5 (but not
-- in case 1 or 7 by setting All_Errors mode, or by setting the special
-- unconditional message insertion character (!) as described below.
-- This normal suppression action may be overridden in cases 2-5 (but
-- not in case 1) by setting All_Errors mode, or by setting the special
-- unconditional message insertion character (!) as described below.
---------------------------------------------------------
-- Error Message Text and Message Insertion Characters --
......
gcc/ada/exp_ch3.adb
......@@ -760,8 +760,10 @@ package body Exp_Ch3 is
-- want to inline, because nested stuff may cause difficulties in
-- inter-unit inlining, and furthermore there is in any case no
-- point in inlining such complex init procs.
-- Also do not inline in case of Modify_Tree_For_C where front-end
-- inlining is used and may not always play well with init procs.
if not Has_Task (Proc_Id) then
if not Has_Task (Proc_Id) and then not Modify_Tree_For_C then
Set_Is_Inlined (Proc_Id);
end if;
......@@ -3598,9 +3600,12 @@ package body Exp_Ch3 is
-- In addition, when compiled for another unit for inlining purposes,
-- it may make reference to entities that have not been elaborated
-- yet. Similar considerations apply to task types.
-- Also do not inline in case of Modify_Tree_For_C where front-end
-- inlining is used and may not always play well with init procs.
if not Is_Concurrent_Type (Rec_Type)
and then not Has_Task (Rec_Type)
and then not Modify_Tree_For_C
then
Set_Is_Inlined (Proc_Id);
end if;
......
gcc/ada/sem_ch13.adb
......@@ -4219,8 +4219,6 @@ package body Sem_Ch13 is
------------------------------
procedure Check_Iterator_Functions is
Default : Entity_Id;
function Valid_Default_Iterator (Subp : Entity_Id) return Boolean;
-- Check one possible interpretation for validity
......@@ -4277,8 +4275,8 @@ package body Sem_Ch13 is
end if;
else
Default := Empty;
declare
Default : Entity_Id := Empty;
I : Interp_Index;
It : Interp;
......@@ -4292,6 +4290,10 @@ package body Sem_Ch13 is
elsif Present (Default) then
Error_Msg_N ("default iterator must be unique", Expr);
Error_Msg_Sloc := Sloc (Default);
Error_Msg_N ("\\possible interpretation#", Expr);
Error_Msg_Sloc := Sloc (It.Nam);
Error_Msg_N ("\\possible interpretation#", Expr);
else
Default := It.Nam;
......@@ -4299,12 +4301,12 @@ package body Sem_Ch13 is
Get_Next_Interp (I, It);
end loop;
end;
if Present (Default) then
Set_Entity (Expr, Default);
Set_Is_Overloaded (Expr, False);
end if;
if Present (Default) then
Set_Entity (Expr, Default);
Set_Is_Overloaded (Expr, False);
end if;
end;
end if;
end Check_Iterator_Functions;
......
gcc/ada/sem_ch3.adb
......@@ -15012,11 +15012,27 @@ package body Sem_Ch3 is
-- Given that this new interface entity corresponds with a primitive
-- of the parent that was not overridden we must leave it associated
-- with its parent primitive to ensure that it will share the same
-- dispatch table slot when overridden.
-- dispatch table slot when overridden. We must set the Alias to Subp
-- (instead of Iface_Subp), and we must fix Is_Abstract_Subprogram
-- (in case we inherited Subp from Iface_Type via a nonabstract
-- generic formal type).
if No (Actual_Subp) then
Set_Alias (New_Subp, Subp);
declare
T : Entity_Id := Find_Dispatching_Type (Subp);
begin
while Etype (T) /= T loop
if Is_Generic_Type (T) and then not Is_Abstract_Type (T) then
Set_Is_Abstract_Subprogram (New_Subp, False);
exit;
end if;
T := Etype (T);
end loop;
end;
-- For instantiations this is not needed since the previous call to
-- Derive_Subprogram leaves the entity well decorated.
......
gcc/ada/sinfo.ads
......@@ -735,6 +735,9 @@ package Sinfo is
-- they are systematically expanded into loops (for arrays) and
-- individual assignments (for records).
-- Initialization procedures (init procs) for records and arrays are
-- not inlined.
------------------------------------
-- Description of Semantic Fields --
------------------------------------
......
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