OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb: Flag263 is now known as Has_Null_Refinement.
	(Has_Null_Refinement): New routine.
	(Set_Has_Null_Refinement): New routine.
	(Write_Entity_Flags): Output the status of flag
	Has_Null_Refinement.
	* einfo.ads: Add new flag Has_Null_Refinement along with
	comment on usage and update all nodes subject to the flag.
	(Has_Null_Refinement): New routine along with pragma Inline.
	(Set_Has_Null_Refinement): New rouitine along with pragma Inline.
	* sem_prag.adb (Analyze_Constituent): Mark a state as having
	a null refinement when the sole constituent is "null".
	(Analyze_Global_List): Handle null input/output items.
	(Analyze_Refined_Global_In_Decl_Part): Add local variable
	Has_Null_State. Add logic to handle combinations of states
	with null refinements and null global lists and/or items.
	(Check_In_Out_States, Check_Input_States, Check_Output_States):
	Use attribute Has_Null_Refinement to detect states with
	constituents.
	(Check_Refined_Global_List): Handle null input/output items.
	(Process_Global_Item): Handle states with null refinements.
	(Process_Global_List): Handle null input/output items.

2013-10-14  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Entity): Reset Is_True_Constant for
	aliased object
	* gnat_ugn.texi: Update doc on aliased variables and constants.

2013-10-14  Ed Schonberg  <schonberg@adacore.com>

	* exp_pakd.adb (Expand_Packed_Element_Reference): If the
	reference is an actual in a call, the prefix has not been fully
	expanded, to account for the additional expansion for parameter
	passing. the prefix itself is a packed reference as well,
	recurse to complete the transformation of the prefix.

2013-10-14  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_dbug.adb (Debug_Renaming_Declaration): Do not
	materialize the entity when the renamed object contains an
	N_Explicit_Dereference.
	* sem_ch8.adb (Analyze_Object_Renaming):
	If the renaming comes from source and the renamed object is a
	dereference, mark the prefix as needing debug information.

2013-10-14  Doug Rupp  <rupp@adacore.com>

	* system-vxworks-arm.ads (Stack_Check_Probes, Stack_Check_Limits):
	Enable Stack Probes, Disable Stack Limit Checking.
	* init.c [VxWorks] (__gnat_inum_to_ivec): Caste return value.
	(__gnat_map_signal): Fix signature.
	(__gnat_error_handler): Make
	static, fix signature, remove prototype, fix prototype warning.
	[ARMEL and VxWorks6] (__gnat_map_signal): Check and re-arm guard
	page for storage_error.
	* exp_pakd.adb: Minor reformatting.

From-SVN: r203526
This commit is contained in:
Arnaud Charlet 2013-10-14 14:42:04 +02:00
parent b447a7578e
commit 124092ee8a
11 changed files with 370 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
gcc/ada/ChangeLog
View File

@ -1,3 +1,62 @@
2013-10-14 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb: Flag263 is now known as Has_Null_Refinement.
(Has_Null_Refinement): New routine.
(Set_Has_Null_Refinement): New routine.
(Write_Entity_Flags): Output the status of flag
Has_Null_Refinement.
* einfo.ads: Add new flag Has_Null_Refinement along with
comment on usage and update all nodes subject to the flag.
(Has_Null_Refinement): New routine along with pragma Inline.
(Set_Has_Null_Refinement): New rouitine along with pragma Inline.
* sem_prag.adb (Analyze_Constituent): Mark a state as having
a null refinement when the sole constituent is "null".
(Analyze_Global_List): Handle null input/output items.
(Analyze_Refined_Global_In_Decl_Part): Add local variable
Has_Null_State. Add logic to handle combinations of states
with null refinements and null global lists and/or items.
(Check_In_Out_States, Check_Input_States, Check_Output_States):
Use attribute Has_Null_Refinement to detect states with
constituents.
(Check_Refined_Global_List): Handle null input/output items.
(Process_Global_Item): Handle states with null refinements.
(Process_Global_List): Handle null input/output items.
2013-10-14 Robert Dewar <dewar@adacore.com>
* freeze.adb (Freeze_Entity): Reset Is_True_Constant for
aliased object
* gnat_ugn.texi: Update doc on aliased variables and constants.
2013-10-14 Ed Schonberg <schonberg@adacore.com>
* exp_pakd.adb (Expand_Packed_Element_Reference): If the
reference is an actual in a call, the prefix has not been fully
expanded, to account for the additional expansion for parameter
passing. the prefix itself is a packed reference as well,
recurse to complete the transformation of the prefix.
2013-10-14 Eric Botcazou <ebotcazou@adacore.com>
* exp_dbug.adb (Debug_Renaming_Declaration): Do not
materialize the entity when the renamed object contains an
N_Explicit_Dereference.
* sem_ch8.adb (Analyze_Object_Renaming):
If the renaming comes from source and the renamed object is a
dereference, mark the prefix as needing debug information.
2013-10-14 Doug Rupp <rupp@adacore.com>
* system-vxworks-arm.ads (Stack_Check_Probes, Stack_Check_Limits):
Enable Stack Probes, Disable Stack Limit Checking.
* init.c [VxWorks] (__gnat_inum_to_ivec): Caste return value.
(__gnat_map_signal): Fix signature.
(__gnat_error_handler): Make
static, fix signature, remove prototype, fix prototype warning.
[ARMEL and VxWorks6] (__gnat_map_signal): Check and re-arm guard
page for storage_error.
* exp_pakd.adb: Minor reformatting.
2013-10-14 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Global_In_Decl_Part): Remove local

15
gcc/ada/einfo.adb
View File

@ -551,8 +551,8 @@ package body Einfo is
-- Has_Delayed_Rep_Aspects Flag261
-- May_Inherit_Delayed_Rep_Aspects Flag262
-- Has_Null_Refinement Flag263
-- (unused) Flag263
-- (unused) Flag264
-- (unused) Flag265
-- (unused) Flag266
@ -1483,6 +1483,12 @@ package body Einfo is
return Flag75 (Implementation_Base_Type (Id));
end Has_Non_Standard_Rep;
function Has_Null_Refinement (Id : E) return B is
begin
pragma Assert (Ekind (Id) = E_Abstract_State);
return Flag263 (Id);
end Has_Null_Refinement;
function Has_Object_Size_Clause (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
@ -4104,6 +4110,12 @@ package body Einfo is
Set_Flag75 (Id, V);
end Set_Has_Non_Standard_Rep;
procedure Set_Has_Null_Refinement (Id : E; V : B := True) is
begin
pragma Assert (Ekind (Id) = E_Abstract_State);
Set_Flag263 (Id, V);
end Set_Has_Null_Refinement;
procedure Set_Has_Object_Size_Clause (Id : E; V : B := True) is
begin
pragma Assert (Is_Type (Id));
@ -7957,6 +7969,7 @@ package body Einfo is
W ("Has_Missing_Return", Flag142 (Id));
W ("Has_Nested_Block_With_Handler", Flag101 (Id));
W ("Has_Non_Standard_Rep", Flag75 (Id));
W ("Has_Null_Refinement", Flag263 (Id));
W ("Has_Object_Size_Clause", Flag172 (Id));
W ("Has_Per_Object_Constraint", Flag154 (Id));
W ("Has_Postconditions", Flag240 (Id));

163
gcc/ada/einfo.ads
View File

@ -505,10 +505,10 @@ package Einfo is
-- Can_Never_Be_Null (Flag38)
-- This flag is defined in all entities, but can only be set in an object
-- which can never have a null value. This is set True for constant
-- access values initialized to a non-null value. This is also True for
-- all access parameters in Ada 83 and Ada 95 modes, and for access
-- parameters that explicitly exclude null in Ada 2005.
-- which can never have a null value. Set for constant access values
-- initialized to a non-null value. This is also set for all access
-- parameters in Ada 83 and Ada 95 modes, and for access parameters
-- that explicitly exclude null in Ada 2005.
--
-- This is used to avoid unnecessary resetting of the Is_Known_Non_Null
-- flag for such entities. In Ada 2005 mode, this is also used when
@ -651,7 +651,7 @@ package Einfo is
-- 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
-- set True). Points to the entity for the corresponding task type or
-- set). Points to the entity for the corresponding task type or the
-- protected type.
-- Corresponding_Discriminant (Node19)
@ -1361,14 +1361,14 @@ package Einfo is
-- of derived type declarations).
-- Has_All_Calls_Remote (Flag79)
-- Defined in all library unit entities. Set true if the library unit
-- has an All_Calls_Remote pragma. Note that such entities must also
-- be RCI entities, so the flag Is_Remote_Call_Interface will always
-- be set if this flag is set.
-- Defined in all library unit entities. Set if the library unit has an
-- All_Calls_Remote pragma. Note that such entities must also be RCI
-- entities, so the flag Is_Remote_Call_Interface will always be set if
-- this flag is set.
-- Has_Anonymous_Master (Flag253)
-- Defined in units (top-level functions and procedures, library-level
-- packages). Set to True if the associated unit contains a heterogeneous
-- packages). Set if the associated unit contains a heterogeneous
-- finalization master. The master's name is of the form <unit>AM and it
-- services anonymous access-to-controlled types with an undetermined
-- lifetime.
@ -1438,11 +1438,11 @@ package Einfo is
-- in sem_aux is used to test for this case.
-- Has_Contiguous_Rep (Flag181)
-- Defined in enumeration types. True if the type as a representation
-- 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. True if the function is a primitive
-- 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]
@ -1452,13 +1452,13 @@ package Einfo is
-- Has_Controlled_Component is set for at least one component).
-- Has_Convention_Pragma (Flag119)
-- Defined in all entities. Set true for an entity for which a valid
-- Convention, Import, or Export pragma has been given. Used to prevent
-- more than one such pragma appearing for a given entity (RM B.1(45)).
-- Defined in all entities. Set for an entity for which a valid pragma
-- Convention, Import, or Export has been given. Used to prevent more
-- than one such pragma appearing for a given entity (RM B.1(45)).
-- Has_Delayed_Aspects (Flag200)
-- Defined in all entities. Set true if the Rep_Item chain for the entity
-- has one or more N_Aspect_Definition nodes chained which are not to be
-- Defined in all entities. Set if the Rep_Item chain for the entity has
-- one or more N_Aspect_Definition nodes chained which are not to be
-- evaluated till the freeze point. The aspect definition expression
-- clause has been preanalyzed to get visibility at the point of use,
-- but no other action has been taken.
@ -1531,18 +1531,18 @@ package Einfo is
-- Convention_Intrinsic, Convention_Entry or Convention_Protected).
-- Has_Forward_Instantiation (Flag175)
-- Defined in package entities. Set true for packages that contain
-- instantiations of local generic entities, before the corresponding
-- generic body has been seen. If a package has a forward instantiation,
-- we cannot inline subprograms appearing in the same package because
-- the placement requirements of the instance will conflict with the
-- linear elaboration of front-end inlining.
-- Defined in package entities. Set for packages that instantiate local
-- generic entities before the corresponding generic body has been seen.
-- If a package has a forward instantiation, we cannot inline subprograms
-- appearing in the same package because the placement requirements of
-- the instance will conflict with the linear elaboration of front-end
-- inlining.
-- Has_Fully_Qualified_Name (Flag173)
-- Defined in all entities. Set True if the name in the Chars field has
-- been replaced by the fully qualified name, as used for debug output.
-- See Exp_Dbug for a full description of the use of this flag and also
-- the related flag Has_Qualified_Name.
-- Defined in all entities. Set if the name in the Chars field has been
-- replaced by the fully qualified name, as used for debug output. See
-- Exp_Dbug for a full description of the use of this flag and also the
-- related flag Has_Qualified_Name.
-- Has_Gigi_Rep_Item (Flag82)
-- Defined in all entities. Set if the rep item chain (referenced by
@ -1576,7 +1576,7 @@ package Einfo is
-- applies (as set by coresponding pragma or aspect specification).
-- Has_Inheritable_Invariants (Flag248)
-- Defined in all type entities. Set True in private types from which one
-- Defined in all type entities. Set in private types from which one
-- or more Invariant'Class aspects will be inherited if a another type is
-- derived from the type (i.e. those types which have an Invariant'Class
-- aspect, or which inherit one or more Invariant'Class aspects). Also
@ -1599,7 +1599,7 @@ package Einfo is
-- Interrupt_Handler applies.
-- Has_Invariants (Flag232)
-- Defined in all type entities and in subprogram entities. Set True in
-- Defined in all type entities and in subprogram entities. Set in
-- private types if an Invariant or Invariant'Class aspect applies to the
-- type, or if the type inherits one or more Invariant'Class aspects.
-- Also set in the corresponding full type. Note: if this flag is set
@ -1650,15 +1650,19 @@ package Einfo is
-- Defined in package entities. True if the package is subject to a null
-- Abstract_State aspect/pragma.
-- Has_Null_Refinement (Flag263)
-- Defined in E_Abstract_State entities. Set if the state has a null
-- refinement in aspect/pragma Refined_State.
-- Has_Object_Size_Clause (Flag172)
-- Defined in entities for types and subtypes. Set if an Object_Size
-- clause has been processed for the type Used to prevent multiple
-- Object_Size clauses for a given entity.
-- Has_Per_Object_Constraint (Flag154)
-- Defined in E_Component entities, true if the subtype of the
-- component has a per object constraint. Per object constraints result
-- from the following situations:
-- Defined in E_Component entities. Set if the subtype of the component
-- has a per object constraint. Per object constraints result from the
-- following situations :
--
-- 1. N_Attribute_Reference - when the prefix is the enclosing type and
-- the attribute is Access.
@ -1770,27 +1774,27 @@ package Einfo is
-- some ancestor is derived from a private type, making some components
-- invisible and aggregates illegal. Used to check the legality of
-- selected components and aggregates. The flag is set at the point of
-- derivation.
-- The legality of an aggregate of a type with a private ancestor must
-- be checked because it also depends on the visibility at the point the
-- aggregate is resolved. See sem_aggr.adb. This is part of AI05-0115.
-- derivation. The legality of an aggregate of a type with a private
-- ancestor must be checked because it also depends on the visibility
-- at the point the aggregate is resolved. See sem_aggr.adb. This is
-- part of AI05-0115.
-- Has_Private_Declaration (Flag155)
-- Defined in all entities. Returns True if it is the defining entity
-- of a private type declaration or its corresponding full declaration.
-- This flag is thus preserved when the full and the partial views are
-- exchanged, to indicate if a full type declaration is a completion.
-- Used for semantic checks in E.4(18) and elsewhere.
-- Defined in all entities. Set if it is the defining entity of a private
-- type declaration or its corresponding full declaration. This flag is
-- thus preserved when the full and the partial views are exchanged, to
-- indicate if a full type declaration is a completion. Used for semantic
-- checks in E.4(18) and elsewhere.
-- Has_Qualified_Name (Flag161)
-- Defined in all entities. Set True if the name in the Chars field
-- has been replaced by its qualified name, as used for debug output.
-- See Exp_Dbug for a full description of qualification requirements.
-- For some entities, the name is the fully qualified name, but there
-- are exceptions. In particular, for local variables in procedures,
-- we do not include the procedure itself or higher scopes. See also
-- the flag Has_Fully_Qualified_Name, which is set if the name does
-- indeed include the fully qualified name.
-- Defined in all entities. Set if the name in the Chars field has
-- been replaced by its qualified name, as used for debug output. See
-- Exp_Dbug for a full description of qualification requirements. For
-- some entities, the name is the fully qualified name, but there are
-- exceptions. In particular, for local variables in procedures, we
-- do not include the procedure itself or higher scopes. See also the
-- flag Has_Fully_Qualified_Name, which is set if the name does indeed
-- include the fully qualified name.
-- Has_RACW (Flag214)
-- Defined in package spec entities. Set if the spec contains the
@ -2168,7 +2172,7 @@ package Einfo is
-- Set if the type or subtype is constrained.
-- Is_Constr_Subt_For_U_Nominal (Flag80)
-- Defined in all types and subtypes. Set true only for the constructed
-- Defined in all types and subtypes. Set only for the constructed
-- subtype of an object whose nominal subtype is unconstrained. Note
-- that the constructed subtype itself will be constrained.
@ -2225,9 +2229,9 @@ package Einfo is
-- entity is associated with a dispatch table.
-- Is_Dispatching_Operation (Flag6)
-- Defined in all entities. Set true for procedures, functions,
-- generic procedures and generic functions if the corresponding
-- operation is dispatching.
-- Defined in all entities. Set for procedures, functions, generic
-- procedures, and generic functions if the corresponding operation
-- is dispatching.
-- Is_Dynamic_Scope (synthesized)
-- Applies to all Entities. Returns True if the entity is a dynamic
@ -2253,9 +2257,9 @@ package Einfo is
-- entities and False for all other entity kinds.
-- Is_Entry_Formal (Flag52)
-- Defined in all entities. Set only for entry formals (which can
-- only 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.
-- Defined in all entities. Set only for entry formals (which can only
-- 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_Exported (Flag99)
-- Defined in all entities. Set if the entity is exported. For now we
@ -2338,7 +2342,7 @@ package Einfo is
-- convention.
-- Is_Hidden (Flag57)
-- Defined in all entities. Set true for all entities declared in the
-- Defined in all entities. Set for all entities declared in the
-- private part or body of a package. Also marks generic formals of a
-- formal package declared without a box. For library level entities,
-- this flag is set if the entity is not publicly visible. This flag
@ -2348,7 +2352,7 @@ package Einfo is
-- Private_Declaration in sem_ch7).
-- Is_Hidden_Open_Scope (Flag171)
-- Defined in all entities. Set true for a scope that contains the
-- Defined in all entities. Set for a scope that contains the
-- instantiation of a child unit, and whose entities are not visible
-- during analysis of the instance.
@ -2462,20 +2466,20 @@ package Einfo is
-- to be defined) must be in the same scope as the type.
-- Is_Known_Non_Null (Flag37)
-- Defined in all entities. Relevant (and can be set True) only for
-- Defined in all entities. Relevant (and can be set) only for
-- objects of an access type. It is set if the object is currently
-- known to have a non-null value (meaning that no access checks
-- are needed). The indication can for example come from assignment
-- of an access parameter or an allocator whose value is known non-null.
--
-- Note: this flag is set according to the sequential flow of the
-- program, watching the current value of the variable. However,
-- this processing can miss cases of changing the value of an aliased
-- or constant object, so even if this flag is set, it should not
-- be believed if the variable is aliased or volatile. It would
-- be a little neater to avoid the flag being set in the first
-- place in such cases, but that's trickier, and there is only
-- one place that tests the value anyway.
-- program, watching the current value of the variable. However, this
-- processing can miss cases of changing the value of an aliased or
-- constant object, so even if this flag is set, it should not be
-- believed if the variable is aliased or volatile. It would be a
-- little neater to avoid the flag being set in the first place in
-- such cases, but that's trickier, and there is only one place that
-- tests the value anyway.
--
-- The flag is dynamically set and reset as semantic analysis and
-- expansion proceeds. Its value is meaningless once the tree is
@ -2483,7 +2487,7 @@ package Einfo is
-- Thus this flag has no meaning to the back end.
-- Is_Known_Null (Flag204)
-- Defined in all entities. Relevant (and can be set True) only for
-- Defined in all entities. Relevant (and can be set ) only for
-- objects of an access type. It is set if the object is currently known
-- to have a null value (meaning that a dereference will surely raise
-- constraint error exception). The indication can come from an
@ -2841,7 +2845,7 @@ package Einfo is
-- Wide_Wide_Character).
-- Is_Statically_Allocated (Flag28)
-- Defined in all entities. This can only be set True for exception,
-- Defined in all entities. This can only be set for exception,
-- variable, constant, and type/subtype entities. If the flag is set,
-- then the variable or constant must be allocated statically rather
-- than on the local stack frame. For exceptions, the meaning is that
@ -2951,7 +2955,7 @@ package Einfo is
-- or Export_Valued_Procedure pragma applies to the procedure entity.
-- Is_Visible_Formal (Flag206)
-- Defined in all entities. Set True for instances of the formals of a
-- Defined in all entities. Set for instances of the formals of a
-- formal package. Indicates that the entity must be made visible in the
-- body of the instance, to reproduce the visibility of the generic.
-- This simplifies visibility settings in instance bodies.
@ -3058,10 +3062,10 @@ package Einfo is
-- Value attributes for the enumeration type in question.
-- Low_Bound_Tested (Flag205)
-- Defined in all entities. Currently this can only be set True for
-- formal parameter entries of a standard unconstrained one-dimensional
-- array or string type. Indicates that an explicit test of the low bound
-- of the formal appeared in the code, e.g. in a pragma Assert. If this
-- Defined in all entities. Currently this can only be set for formal
-- parameter entries of a standard unconstrained one-dimensional array
-- or string type. Indicates that an explicit test of the low bound of
-- the formal appeared in the code, e.g. in a pragma Assert. If this
-- flag is set, warnings about assuming the index low bound to be one
-- are suppressed.
@ -3252,8 +3256,8 @@ package Einfo is
-- the defining entity in the original declaration.
-- Nonzero_Is_True (Flag162) [base type only]
-- Defined in enumeration types. True if any non-zero value is to be
-- interpreted as true. Currently this is set true for derived Boolean
-- Defined in enumeration types. Set if any non-zero value is to be
-- interpreted as true. Currently this is set for derived Boolean
-- types which have a convention of C, C++ or Fortran.
-- No_Pool_Assigned (Flag131) [root type only]
@ -3796,8 +3800,8 @@ package Einfo is
-- Static_Predicate (List25)
-- Defined in discrete types/subtypes with predicates (Has_Predicates
-- set True). Set if the type/subtype has a static predicate. Points to
-- a list of expression and N_Range nodes that represent the predicate
-- set). Set if the type/subtype has a static predicate. Points to a
-- list of expression and N_Range nodes that represent the predicate
-- in canonical form. The canonical form has entries sorted in ascending
-- order, with duplicates eliminated, and adjacent ranges coalesced, so
-- that there is always a gap in the values between successive entries.
@ -5104,6 +5108,7 @@ package Einfo is
-- E_Abstract_State
-- Refinement_Constituents (Elist8)
-- Refined_State (Node10)
-- Has_Null_Refinement (Flag263)
-- Is_External_State (synth)
-- Is_Input_Only_State (synth)
-- Is_Null_State (synth)
@ -6344,6 +6349,7 @@ package Einfo is
function Has_Missing_Return (Id : E) return B;
function Has_Nested_Block_With_Handler (Id : E) return B;
function Has_Non_Standard_Rep (Id : E) return B;
function Has_Null_Refinement (Id : E) return B;
function Has_Object_Size_Clause (Id : E) return B;
function Has_Per_Object_Constraint (Id : E) return B;
function Has_Postconditions (Id : E) return B;
@ -6957,6 +6963,7 @@ package Einfo is
procedure Set_Has_Missing_Return (Id : E; V : B := True);
procedure Set_Has_Nested_Block_With_Handler (Id : E; V : B := True);
procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True);
procedure Set_Has_Null_Refinement (Id : E; V : B := True);
procedure Set_Has_Object_Size_Clause (Id : E; V : B := True);
procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True);
procedure Set_Has_Postconditions (Id : E; V : B := True);
@ -7672,6 +7679,7 @@ package Einfo is
pragma Inline (Has_Missing_Return);
pragma Inline (Has_Nested_Block_With_Handler);
pragma Inline (Has_Non_Standard_Rep);
pragma Inline (Has_Null_Refinement);
pragma Inline (Has_Object_Size_Clause);
pragma Inline (Has_Per_Object_Constraint);
pragma Inline (Has_Postconditions);
@ -8132,6 +8140,7 @@ package Einfo is
pragma Inline (Set_Has_Missing_Return);
pragma Inline (Set_Has_Nested_Block_With_Handler);
pragma Inline (Set_Has_Non_Standard_Rep);
pragma Inline (Set_Has_Null_Refinement);
pragma Inline (Set_Has_Object_Size_Clause);
pragma Inline (Set_Has_Per_Object_Constraint);
pragma Inline (Set_Has_Postconditions);

1
gcc/ada/exp_dbug.adb
View File

@ -411,7 +411,6 @@ package body Exp_Dbug is
Ren := Prefix (Ren);
when N_Explicit_Dereference =>
Set_Materialize_Entity (Ent);
Prepend_String_To_Buffer ("XA");
Ren := Prefix (Ren);

15
gcc/ada/exp_pakd.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
@ -1992,6 +1992,19 @@ package body Exp_Pakd is
Arg : Node_Id;
begin
-- If the node is an actual in a call, the prefix has not been fully
-- expanded, to account for the additional expansion for in-out actuals
-- (see expand_actuals for details). If the prefix itself is a packed
-- reference as well, we have to recurse to complete the transformation
-- of the prefix.
if Nkind (Prefix (N)) = N_Indexed_Component
and then not Analyzed (Prefix (N))
and then Is_Bit_Packed_Array (Etype (Prefix (Prefix (N))))
then
Expand_Packed_Element_Reference (Prefix (N));
end if;
-- If not bit packed, we have the enumeration case, which is easily
-- dealt with (just adjust the subscripts of the indexed component)

19
gcc/ada/freeze.adb
View File

@ -3345,6 +3345,24 @@ package body Freeze is
Check_Address_Clause (E);
-- Reset Is_True_Constant for aliased object. We consider that
-- the fact that something is aliased may indicate that some
-- funny business is going on, e.g. an aliased object is passed
-- by reference to a procedure which captures the address of
-- the object, which is later used to assign a new value. Such
-- code is highly dubious, but we choose to make it "work" for
-- aliased objects.
-- However, we don't do that for internal entities. We figure
-- that if we deliberately set Is_True_Constant for an internal
-- entity, e.g. a dispatch table entry, then we mean it!
if (Is_Aliased (E) or else Is_Aliased (Etype (E)))
and then not Is_Internal_Name (Chars (E))
then
Set_Is_True_Constant (E, False);
end if;
-- If the object needs any kind of default initialization, an
-- error must be issued if No_Default_Initialization applies.
-- The check doesn't apply to imported objects, which are not
@ -3521,7 +3539,6 @@ package body Freeze is
end if;
end;
end if;
end if;
-- Case of a type or subtype being frozen

53
gcc/ada/gnat_ugn.texi
View File

@ -10004,6 +10004,7 @@ some guidelines on debugging optimized code.
* Vectorization of loops::
* Other Optimization Switches::
* Optimization and Strict Aliasing::
* Aliased Variables and Optimization::
@ifset vms
* Coverage Analysis::
@ -10802,6 +10803,58 @@ has on size and speed of the code. If you really need to use
review any uses of unchecked conversion of access types,
particularly if you are getting the warnings described above.
@node Aliased Variables and Optimization
@subsection Aliased Variables and Optimization
@cindex Aliasing
There are scenarios in which programs may
use low level techniques to modify variables
that otherwise might be considered to be unassigned. For example,
a variable can be passed to a procedure by reference, which takes
the address of the parameter and uses the address to modify the
variable's value, even though it is passed as an IN parameter.
Consider the following example:
@smallexample @c ada
procedure P is
Max_Length : constant Natural := 16;
type Char_Ptr is access all Character;
procedure Get_String(Buffer: Char_Ptr; Size : Integer);
pragma Import (C, Get_String, "get_string");
Name : aliased String (1 .. Max_Length) := (others => ' ');
Temp : Char_Ptr;
function Addr (S : String) return Char_Ptr is
function To_Char_Ptr is
new Ada.Unchecked_Conversion (System.Address, Char_Ptr);
begin
return To_Char_Ptr (S (S'First)'Address);
end;
begin
Temp := Addr (Name);
Get_String (Temp, Max_Length);
end;
@end smallexample
@noindent
where Get_String is a C function that uses the address in Temp to
modify the variable @code{Name}. This code is dubious, and arguably
erroneous, and the compiler would be entitled to assume that
@code{Name} is never modified, and generate code accordingly.
However, in practice, this would cause some existing code that
seems to work with no optimization to start failing at high
levels of optimzization.
What the compiler does for such cases is to assume that marking
a variable as aliased indicates that some "funny business" may
be going on. The optimizer recognizes the aliased keyword and
inhibits optimizations that assume the value cannot be assigned.
This means that the above example will in fact "work" reliably,
that is, it will produce the expected results.
@ifset vms
@node Coverage Analysis
@subsection Coverage Analysis

64
gcc/ada/init.c
View File

@ -1665,8 +1665,6 @@ __gnat_install_handler ()
#include "private/vThreadsP.h"
#endif
void __gnat_error_handler (int, void *, struct sigcontext *);
#ifndef __RTP__
/* Directly vectored Interrupt routines are not supported when using RTPs. */
@ -1677,7 +1675,7 @@ extern int __gnat_inum_to_ivec (int);
int
__gnat_inum_to_ivec (int num)
{
return INUM_TO_IVEC (num);
return (int) INUM_TO_IVEC (num);
}
#endif
@ -1711,8 +1709,8 @@ __gnat_clear_exception_count (void)
/* Handle different SIGnal to exception mappings in different VxWorks
versions. */
static void
__gnat_map_signal (int sig, void *si ATTRIBUTE_UNUSED,
struct sigcontext *sc ATTRIBUTE_UNUSED)
__gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED,
void *sc ATTRIBUTE_UNUSED)
{
struct Exception_Data *exception;
const char *msg;
@ -1799,6 +1797,56 @@ __gnat_map_signal (int sig, void *si ATTRIBUTE_UNUSED,
msg = "unhandled signal";
}
/* On ARM VxWorks 6.x, the guard page is left in a RWX state by the kernel
after being violated, so subsequent violations aren't detected. Even if
this defect is fixed, it seems dubious to rely on the signal value alone,
so we retrieve the address of the guard page from the TCB and compare it
with the page that is violated (pREG 12 in the context) and re-arm that
page if there's a match. Additionally we're are assured this is a
genuine stack overflow condition and and set the message and exception
to that effect. */
#if defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6)
/* We re-arm the guard page by re-setting it's attributes, however the
protection bits are just the low order seven (0x3f).
0x00040 is the Valid Mask
0x00f00 are Cache attributes
0xff000 are Special attributes
We don't meddle with the 0xfff40 attributes. */
#define PAGE_SIZE 4096
#define MMU_ATTR_PROT_MSK 0x0000003f /* Protection Mask. */
#define GUARD_PAGE_PROT 0x8101 /* Found by experiment. */
if (sig == SIGSEGV || sig == SIGBUS || sig == SIGILL)
{
TASK_ID tid = taskIdSelf ();
WIND_TCB *pTcb = taskTcb (tid);
unsigned long Violated_Page
= ((struct sigcontext *) sc)->sc_pregs->r[12] & ~(PAGE_SIZE - 1);
if ((unsigned long) (pTcb->pStackEnd - PAGE_SIZE) == Violated_Page)
{
vmStateSet (NULL, Violated_Page,
PAGE_SIZE, MMU_ATTR_PROT_MSK, GUARD_PAGE_PROT);
exception = &storage_error;
switch (sig)
{
case SIGSEGV:
msg = "SIGSEGV: stack overflow";
break;
case SIGBUS:
msg = "SIGBUS: stack overflow";
break;
case SIGILL:
msg = "SIGILL: stack overflow";
break;
}
}
}
#endif /* defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6) */
__gnat_clear_exception_count ();
Raise_From_Signal_Handler (exception, msg);
}
@ -1806,8 +1854,8 @@ __gnat_map_signal (int sig, void *si ATTRIBUTE_UNUSED,
/* Tasking and Non-tasking signal handler. Map SIGnal to Ada exception
propagation after the required low level adjustments. */
void
__gnat_error_handler (int sig, void *si, struct sigcontext *sc)
static void
__gnat_error_handler (int sig, siginfo_t *si, void *sc)
{
sigset_t mask;
@ -1865,7 +1913,7 @@ __gnat_install_handler (void)
exceptions. Make sure that the handler isn't interrupted by another
signal that might cause a scheduling event! */
act.sa_handler = __gnat_error_handler;
act.sa_sigaction = __gnat_error_handler;
act.sa_flags = SA_SIGINFO | SA_ONSTACK;
sigemptyset (&act.sa_mask);

21
gcc/ada/sem_ch8.adb
View File

@ -1208,11 +1208,22 @@ package body Sem_Ch8 is
-- may have been rewritten in several ways.
elsif Is_Object_Reference (Nam) then
if Comes_From_Source (N)
and then Is_Dependent_Component_Of_Mutable_Object (Nam)
then
Error_Msg_N
("illegal renaming of discriminant-dependent component", Nam);
if Comes_From_Source (N) then
if Is_Dependent_Component_Of_Mutable_Object (Nam) then
Error_Msg_N
("illegal renaming of discriminant-dependent component", Nam);
end if;
-- If the renaming comes from source and the renamed object is a
-- dereference, then mark the prefix as needing debug information,
-- since it might have been rewritten hence internally generated
-- and Debug_Renaming_Declaration will link the renaming to it.
if Nkind (Nam) = N_Explicit_Dereference
and then Is_Entity_Name (Prefix (Nam))
then
Set_Debug_Info_Needed (Entity (Prefix (Nam)));
end if;
end if;
-- A static function call may have been folded into a literal

79
gcc/ada/sem_prag.adb
View File

@ -1600,11 +1600,14 @@ package body Sem_Prag is
-- Start of processing for Analyze_Global_List
begin
if Nkind (List) = N_Null then
null;
-- Single global item declaration
if Nkind_In (List, N_Expanded_Name,
N_Identifier,
N_Selected_Component)
elsif Nkind_In (List, N_Expanded_Name,
N_Identifier,
N_Selected_Component)
then
Analyze_Global_Item (List, Global_Mode);
@ -1691,7 +1694,7 @@ package body Sem_Prag is
-- Local variables
List : Node_Id;
Items : Node_Id;
Subp_Decl : Node_Id;
Restore_Scope : Boolean := False;
@ -1704,11 +1707,11 @@ package body Sem_Prag is
Subp_Decl := Find_Related_Subprogram (N);
Subp_Id := Defining_Unit_Name (Specification (Subp_Decl));
List := Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
Items := Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
-- There is nothing to be done for a null global list
if Nkind (List) = N_Null then
if Nkind (Items) = N_Null then
null;
-- Analyze the various forms of global lists and items. Note that some
@ -1726,7 +1729,7 @@ package body Sem_Prag is
Install_Formals (Subp_Id);
end if;
Analyze_Global_List (List);
Analyze_Global_List (Items);
if Restore_Scope then
End_Scope;
@ -19358,6 +19361,10 @@ package body Sem_Prag is
-- a state of mode Input, In_Out and Output respectively with a visible
-- refinement.
Has_Null_State : Boolean := False;
-- This flag is set when the corresponding Global aspect/pragma has at
-- least one state with a null refinement.
In_Constits : Elist_Id := No_Elist;
In_Out_Constits : Elist_Id := No_Elist;
Out_Constits : Elist_Id := No_Elist;
@ -19512,7 +19519,7 @@ package body Sem_Prag is
-- Ensure that one of the three coverage variants is satisfied
if Ekind (Item_Id) = E_Abstract_State
and then Present (Refinement_Constituents (Item_Id))
and then not Has_Null_Refinement (Item_Id)
then
Check_Constituent_Usage (Item_Id);
end if;
@ -19595,7 +19602,7 @@ package body Sem_Prag is
-- is of mode Input.
if Ekind (Item_Id) = E_Abstract_State
and then Present (Refinement_Constituents (Item_Id))
and then not Has_Null_Refinement (Item_Id)
then
Check_Constituent_Usage (Item_Id);
end if;
@ -19665,7 +19672,7 @@ package body Sem_Prag is
-- have mode Output.
if Ekind (Item_Id) = E_Abstract_State
and then Present (Refinement_Constituents (Item_Id))
and then not Has_Null_Refinement (Item_Id)
then
Check_Constituent_Usage (Item_Id);
end if;
@ -19881,11 +19888,14 @@ package body Sem_Prag is
-- Start of processing for Check_Refined_Global_List
begin
if Nkind (List) = N_Null then
null;
-- Single global item declaration
if Nkind_In (List, N_Expanded_Name,
N_Identifier,
N_Selected_Component)
elsif Nkind_In (List, N_Expanded_Name,
N_Identifier,
N_Selected_Component)
then
Check_Refined_Global_Item (List, Global_Mode);
@ -19963,17 +19973,20 @@ package body Sem_Prag is
begin
-- Signal that the global list contains at least one abstract
-- state with a visible refinement.
-- state with a visible refinement. Note that the refinement
-- may be null in which case there are no constituents.
if Ekind (Item_Id) = E_Abstract_State
and then Present (Refinement_Constituents (Item_Id))
then
if Mode = Name_Input then
Has_In_State := True;
elsif Mode = Name_In_Out then
Has_In_Out_State := True;
elsif Mode = Name_Output then
Has_Out_State := True;
if Ekind (Item_Id) = E_Abstract_State then
if Has_Null_Refinement (Item_Id) then
Has_Null_State := True;
else
if Mode = Name_Input then
Has_In_State := True;
elsif Mode = Name_In_Out then
Has_In_Out_State := True;
elsif Mode = Name_Output then
Has_Out_State := True;
end if;
end if;
end if;
@ -19995,11 +20008,14 @@ package body Sem_Prag is
-- Start of processing for Process_Global_List
begin
if Nkind (List) = N_Null then
null;
-- Single global item declaration
if Nkind_In (List, N_Expanded_Name,
N_Identifier,
N_Selected_Component)
elsif Nkind_In (List, N_Expanded_Name,
N_Identifier,
N_Selected_Component)
then
Process_Global_Item (List, Mode);
@ -20148,11 +20164,13 @@ package body Sem_Prag is
-- The corresponding Global aspect/pragma must mention at least one
-- state with a visible refinement at the point Refined_Global is
-- processed.
-- processed. States with null refinements warrant a Refined_Global
-- aspect/pragma.
if not Has_In_State
and then not Has_In_Out_State
and then not Has_Out_State
and then not Has_Null_State
then
Error_Msg_NE
("useless refinement, subprogram & does not mention abstract state "
@ -20161,13 +20179,15 @@ package body Sem_Prag is
end if;
-- The global refinement of inputs and outputs cannot be null when the
-- corresponding Global aspect/pragma contains at least one item.
-- corresponding Global aspect/pragma contains at least one item except
-- in the case where we have states with null refinements.
if Nkind (List) = N_Null
and then
(Present (In_Items)
or else Present (In_Out_Items)
or else Present (Out_Items))
and then not Has_Null_State
then
Error_Msg_NE
("refinement cannot be null, subprogram & has global items",
@ -20370,8 +20390,11 @@ package body Sem_Prag is
Error_Msg_N
("cannot mix null and non-null constituents", Constit);
-- Mark the related state as having a null refinement
else
Null_Seen := True;
Set_Has_Null_Refinement (State_Id);
end if;
-- Non-null constituents

6
gcc/ada/system-vxworks-arm.ads
View File

@ -7,7 +7,7 @@
-- S p e c --
-- (VxWorks Version ARM) --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -142,8 +142,8 @@ private
Preallocated_Stacks : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
Stack_Check_Limits : constant Boolean := True;
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;