diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-03-15 15:54:14 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-03-15 15:54:14 +0000 |
commit | 4660e715aa628a0071e76853fda39cf8057c2c4e (patch) | |
tree | 826fcec0a5407caae82fabd04cb7e41ec79589fa /gcc/ada/sinfo.adb | |
parent | 90fd25c58b1661a5ad762daba6800b86eb95485e (diff) | |
download | gcc-4660e715aa628a0071e76853fda39cf8057c2c4e.tar.gz |
2005-03-08 Javier Miranda <miranda@adacore.com>
Robert Dewar <dewar@adacore.com>
Thomas Quinot <quinot@adacore.com>
Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* atree.ads, atree.adb: Add support for Elist24 field
* atree.h: Fix wrong definition of Field27
Add support for Elist16 field
Add support for Elist24 field
* einfo.ads, einfo.adb (Abstract_Interfaces,
Set_Abstract_Interfaces): New subprograms.
(Abstract_Interface_Alias, Set_Abstract_Interface_Alias): New
subprograms.
(Access_Disp_Table, Set_Access_Disp_Table): Modified to handle a list of
entities rather than a single node.
(Is_Interface, Set_Is_Interface): New subprogram
(First_Tag_Component): New syntesized attribute
(Next_Tag_Component): New synthesized attribute
(Write_Entity_Flags): Upgraded to write Is_Interface
(Write_Field24_Name): Upgraded to write Abstract_Interfaces
(Write_Field25_Name): Upgraded to write Abstract_Interface_Alias
(Task_Body_Procedure): New subprogram to read this attribute.
(Set_Task_Body_Procedure): New subprogram to set this attribute.
(Has_Controlled_Component): Now applies to all entities.
This is only a documentation change, since it always worked to apply
this to other than composite types (yielding false), but now this is
official.
Update documentation on Must_Be_Byte_Aligned for new spec
* tbuild.adb, exp_dist.adb, exp_disp.adb, exp_ch3.ads, exp_ch3.adb,
exp_attr.adb, exp_aggr.adb, exp_ch4.adb, exp_ch5.adb: Upgrade all the
uses of the Access_Disp_Table attribute to reference the first dispatch
table associated with a tagged type. As
part of the implementation of abstract interface types,
Access_Disp_Table has been redefined to contain a list of dispatch
tables (rather than a single dispatch table).
Similarly, upgrade all the references to Tag_Component by the
new attribute First_Tag_Component.
(Find_Inherited_TSS): Moved to exp_tss.
Clean up test in Expand_N_Object_Declaration for cases
where we need to do a separate assignment of the initial value.
(Expand_N_Object_Declaration): If the expression in the
declaration of a tagged type is an aggregate, no need to generate an
additional tag assignment.
(Freeze_Type): Now a function that returns True if the N_Freeze_Entity
is to be deleted.
Bit packed array ops are only called if operands are known to be
aligned.
(Component_Equality): When returning an N_Raise_Program_Error statement,
ensure that its Etype is set to Empty to avoid confusing GIGI (which
expects that only expressions have a bona fide type).
(Make_Tag_Ctrl_Assignment): Use Build_Actual_Subtype to correctly
determine the amount of data to be copied.
* par.adb (P_Interface_Type_Definition): New subprogram that parses the
new syntax rule of Ada 2005 interfaces (for AI-251 and AI-345):
INTERFACE_TYPE_DEFINITION ::=
[limited | task | protected | synchronized] interface
[AND interface_list]
* par-ch3.adb (P_Type_Declaration): Modified to give support to
interfaces.
(P_Derived_Type_Def_Or_Private_Ext_Decl): Modified to give support to
interfaces.
(P_Interface_Type_Definition): New subprogram that parses the new
syntax rule of Ada 2005 interfaces
(P_Identifier_Declarations): fix two occurrences of 'RENAMES' in error
messages by the correct RENAMES (quotes removed).
* sem_prag.adb: Upgrade all the references to Tag_Component by the new
attribute First_Tag_Component.
* sinfo.ads, sinfo.adb: Remove OK_For_Stream flag, not used, not needed
(Interface_List, Set_Interface_List): New subprograms.
(Interface_Present, Set_Interface_Present): New subprograms.
(Limited_Present, Set_Limited_Present): Available also in derived
type definition nodes.
(Protected_Present, Set_Protected_Present): Available also in
record type definition and
derived type definition nodes.
(Synchronized_Present, Set_Synchronized_Present): New subprograms.
(Task_Present, Set_Task_Present): New subprogram.
(Task_Body_Procedure): Removed.
(Set_Task_Body_Procedure): Removed.
These subprogram have been removed because the attribute
Task_Body_Procedure has been moved to the corresponding task type
or task subtype entity to leave a field free to store the list
of interfaces implemented by a task (for AI-345)
Add Expression field to N_Raise_Statement node for Ada 2005 AI-361
(Null_Exclusion_Present): Change to Flag11, to avoid conflict with
expression flag Do_Range_Check
(Exception_Junk): Change to Flag7 to accomodate above change
(Box_Present, Default_Name, Specification, Set_Box_Present,
Set_Default_Name, Set_Specification): Expand the expression
"X in N_Formal_Subprogram_Declaration" into the corresponding
two comparisons. Required to use the csinfo tool.
* exp_ch11.adb (Expand_N_Raise_Statement): Deal with case where
"with string" given.
* sem_ch11.adb (Analyze_Raise_Statement): Handle case where string
expression given.
* par-ch11.adb (P_Raise_Statement): Recognize with string expression
in 2005 mode
* exp_ch9.adb (Build_Task_Proc_Specification): Modified to use entity
attribute Task_Body_Procedure rather than the old semantic field that
was available in the task_type_declaration node.
* par-ch12.adb (P_Formal_Type_Definition): Modified to handle formal
interface type definitions.
(P_Formal_Derived_Type_Definition): Modified to handle the list of
interfaces.
* par-ch9.adb (P_Task): Modified to handle the list of interfaces in a
task type declaration.
(P_Protected): Modified to handle the list of interfaces in a
protected type declaration.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@96489 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/sinfo.adb')
-rw-r--r-- | gcc/ada/sinfo.adb | 162 |
1 files changed, 112 insertions, 50 deletions
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 33f330143e5..c6117ee7b7c 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -314,8 +314,9 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Component_Association - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind in N_Formal_Subprogram_Declaration); + or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration + or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration + or else NT (N).Nkind = N_Formal_Package_Declaration); return Flag15 (N); end Box_Present; @@ -628,7 +629,8 @@ package body Sinfo is (N : Node_Id) return Node_Id is begin pragma Assert (False - or else NT (N).Nkind in N_Formal_Subprogram_Declaration); + or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration + or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration); return Node2 (N); end Default_Name; @@ -1056,7 +1058,7 @@ package body Sinfo is or else NT (N).Nkind = N_Label or else NT (N).Nkind = N_Object_Declaration or else NT (N).Nkind = N_Subtype_Declaration); - return Flag11 (N); + return Flag7 (N); end Exception_Junk; function Expansion_Delayed @@ -1110,6 +1112,7 @@ package body Sinfo is or else NT (N).Nkind = N_Parameter_Specification or else NT (N).Nkind = N_Pragma_Argument_Association or else NT (N).Nkind = N_Qualified_Expression + or else NT (N).Nkind = N_Raise_Statement or else NT (N).Nkind = N_Return_Statement or else NT (N).Nkind = N_Type_Conversion or else NT (N).Nkind = N_Unchecked_Expression @@ -1403,6 +1406,28 @@ package body Sinfo is return Flag16 (N); end Implicit_With; + function Interface_List + (N : Node_Id) return List_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Formal_Derived_Type_Definition + or else NT (N).Nkind = N_Private_Extension_Declaration + or else NT (N).Nkind = N_Protected_Type_Declaration + or else NT (N).Nkind = N_Record_Definition + or else NT (N).Nkind = N_Task_Type_Declaration); + return List2 (N); + end Interface_List; + + function Interface_Present + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Record_Definition); + return Flag16 (N); + end Interface_Present; + function In_Present (N : Node_Id) return Boolean is begin @@ -1639,6 +1664,7 @@ package body Sinfo is (N : Node_Id) return Boolean is begin pragma Assert (False + or else NT (N).Nkind = N_Derived_Type_Definition or else NT (N).Nkind = N_Formal_Private_Type_Definition or else NT (N).Nkind = N_Private_Type_Declaration or else NT (N).Nkind = N_Record_Definition @@ -1865,7 +1891,7 @@ package body Sinfo is or else NT (N).Nkind = N_Object_Declaration or else NT (N).Nkind = N_Parameter_Specification or else NT (N).Nkind = N_Subtype_Declaration); - return Flag9 (N); + return Flag11 (N); end Null_Exclusion_Present; function Null_Record_Present @@ -1885,14 +1911,6 @@ package body Sinfo is return Node4 (N); end Object_Definition; - function OK_For_Stream - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference); - return Flag4 (N); - end OK_For_Stream; - function Original_Discriminant (N : Node_Id) return Node_Id is begin @@ -2121,8 +2139,10 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Access_Function_Definition - or else NT (N).Nkind = N_Access_Procedure_Definition); - return Flag15 (N); + or else NT (N).Nkind = N_Access_Procedure_Definition + or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Record_Definition); + return Flag6 (N); end Protected_Present; function Raises_Constraint_Error @@ -2296,14 +2316,15 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Abstract_Subprogram_Declaration + or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration + or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration or else NT (N).Nkind = N_Generic_Package_Declaration or else NT (N).Nkind = N_Generic_Subprogram_Declaration or else NT (N).Nkind = N_Package_Declaration or else NT (N).Nkind = N_Subprogram_Body or else NT (N).Nkind = N_Subprogram_Body_Stub or else NT (N).Nkind = N_Subprogram_Declaration - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration - or else NT (N).Nkind in N_Formal_Subprogram_Declaration); + or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); return Node1 (N); end Specification; @@ -2388,6 +2409,15 @@ package body Sinfo is return List2 (N); end Subtype_Marks; + function Synchronized_Present + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Record_Definition); + return Flag7 (N); + end Synchronized_Present; + function Tagged_Present (N : Node_Id) return Boolean is begin @@ -2407,14 +2437,6 @@ package body Sinfo is return Node2 (N); end Target_Type; - function Task_Body_Procedure - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Task_Type_Declaration); - return Node2 (N); - end Task_Body_Procedure; - function Task_Definition (N : Node_Id) return Node_Id is begin @@ -2424,6 +2446,15 @@ package body Sinfo is return Node3 (N); end Task_Definition; + function Task_Present + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Record_Definition); + return Flag5 (N); + end Task_Present; + function Then_Actions (N : Node_Id) return List_Id is begin @@ -2816,8 +2847,9 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Component_Association - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind in N_Formal_Subprogram_Declaration); + or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration + or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration + or else NT (N).Nkind = N_Formal_Package_Declaration); Set_Flag15 (N, Val); end Set_Box_Present; @@ -3130,7 +3162,8 @@ package body Sinfo is (N : Node_Id; Val : Node_Id) is begin pragma Assert (False - or else NT (N).Nkind in N_Formal_Subprogram_Declaration); + or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration + or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration); Set_Node2_With_Parent (N, Val); end Set_Default_Name; @@ -3549,7 +3582,7 @@ package body Sinfo is or else NT (N).Nkind = N_Label or else NT (N).Nkind = N_Object_Declaration or else NT (N).Nkind = N_Subtype_Declaration); - Set_Flag11 (N, Val); + Set_Flag7 (N, Val); end Set_Exception_Junk; procedure Set_Expansion_Delayed @@ -3603,6 +3636,7 @@ package body Sinfo is or else NT (N).Nkind = N_Parameter_Specification or else NT (N).Nkind = N_Pragma_Argument_Association or else NT (N).Nkind = N_Qualified_Expression + or else NT (N).Nkind = N_Raise_Statement or else NT (N).Nkind = N_Return_Statement or else NT (N).Nkind = N_Type_Conversion or else NT (N).Nkind = N_Unchecked_Expression @@ -3896,6 +3930,28 @@ package body Sinfo is Set_Flag16 (N, Val); end Set_Implicit_With; + procedure Set_Interface_List + (N : Node_Id; Val : List_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Formal_Derived_Type_Definition + or else NT (N).Nkind = N_Private_Extension_Declaration + or else NT (N).Nkind = N_Protected_Type_Declaration + or else NT (N).Nkind = N_Record_Definition + or else NT (N).Nkind = N_Task_Type_Declaration); + Set_List2_With_Parent (N, Val); + end Set_Interface_List; + + procedure Set_Interface_Present + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Record_Definition); + Set_Flag16 (N, Val); + end Set_Interface_Present; + procedure Set_In_Present (N : Node_Id; Val : Boolean := True) is begin @@ -4132,6 +4188,7 @@ package body Sinfo is (N : Node_Id; Val : Boolean := True) is begin pragma Assert (False + or else NT (N).Nkind = N_Derived_Type_Definition or else NT (N).Nkind = N_Formal_Private_Type_Definition or else NT (N).Nkind = N_Private_Type_Declaration or else NT (N).Nkind = N_Record_Definition @@ -4358,7 +4415,7 @@ package body Sinfo is or else NT (N).Nkind = N_Object_Declaration or else NT (N).Nkind = N_Parameter_Specification or else NT (N).Nkind = N_Subtype_Declaration); - Set_Flag9 (N, Val); + Set_Flag11 (N, Val); end Set_Null_Exclusion_Present; procedure Set_Null_Record_Present @@ -4378,14 +4435,6 @@ package body Sinfo is Set_Node4_With_Parent (N, Val); end Set_Object_Definition; - procedure Set_OK_For_Stream - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference); - Set_Flag4 (N, Val); - end Set_OK_For_Stream; - procedure Set_Original_Discriminant (N : Node_Id; Val : Node_Id) is begin @@ -4614,8 +4663,10 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Access_Function_Definition - or else NT (N).Nkind = N_Access_Procedure_Definition); - Set_Flag15 (N, Val); + or else NT (N).Nkind = N_Access_Procedure_Definition + or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Record_Definition); + Set_Flag6 (N, Val); end Set_Protected_Present; procedure Set_Raises_Constraint_Error @@ -4789,14 +4840,15 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Abstract_Subprogram_Declaration + or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration + or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration or else NT (N).Nkind = N_Generic_Package_Declaration or else NT (N).Nkind = N_Generic_Subprogram_Declaration or else NT (N).Nkind = N_Package_Declaration or else NT (N).Nkind = N_Subprogram_Body or else NT (N).Nkind = N_Subprogram_Body_Stub or else NT (N).Nkind = N_Subprogram_Declaration - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration - or else NT (N).Nkind in N_Formal_Subprogram_Declaration); + or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); Set_Node1_With_Parent (N, Val); end Set_Specification; @@ -4881,6 +4933,15 @@ package body Sinfo is Set_List2_With_Parent (N, Val); end Set_Subtype_Marks; + procedure Set_Synchronized_Present + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Record_Definition); + Set_Flag7 (N, Val); + end Set_Synchronized_Present; + procedure Set_Tagged_Present (N : Node_Id; Val : Boolean := True) is begin @@ -4900,14 +4961,6 @@ package body Sinfo is Set_Node2 (N, Val); -- semantic field, no parent set end Set_Target_Type; - procedure Set_Task_Body_Procedure - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Task_Type_Declaration); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Task_Body_Procedure; - procedure Set_Task_Definition (N : Node_Id; Val : Node_Id) is begin @@ -4917,6 +4970,15 @@ package body Sinfo is Set_Node3_With_Parent (N, Val); end Set_Task_Definition; + procedure Set_Task_Present + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Record_Definition); + Set_Flag5 (N, Val); + end Set_Task_Present; + procedure Set_Then_Actions (N : Node_Id; Val : List_Id) is begin |