-- are used for the flags Analyzed, Comes_From_Source, and Error_Posted,
-- which are common to all nodes, including entity nodes.
- -- Is_Frozen Flag4
- -- Has_Discriminants Flag5
- -- Is_Dispatching_Operation Flag6
- -- Is_Immediately_Visible Flag7
- -- In_Use Flag8
- -- Is_Potentially_Use_Visible Flag9
- -- Is_Public Flag10
-
- -- Is_Inlined Flag11
- -- Is_Constrained Flag12
- -- Is_Generic_Type Flag13
- -- Depends_On_Private Flag14
- -- Is_Aliased Flag15
- -- Is_Volatile Flag16
- -- Is_Internal Flag17
- -- Has_Delayed_Freeze Flag18
- -- Is_Abstract Flag19
- -- Is_Concurrent_Record_Type Flag20
-
- -- Has_Master_Entity Flag21
- -- Needs_No_Actuals Flag22
- -- Has_Storage_Size_Clause Flag23
- -- Is_Imported Flag24
- -- Is_Limited_Record Flag25
- -- Has_Completion Flag26
- -- Has_Pragma_Controlled Flag27
- -- Is_Statically_Allocated Flag28
- -- Has_Size_Clause Flag29
- -- Has_Task Flag30
-
- -- Checks_May_Be_Suppressed Flag31
- -- Kill_Elaboration_Checks Flag32
- -- Kill_Range_Checks Flag33
- -- Kill_Tag_Checks Flag34
- -- Is_Class_Wide_Equivalent_Type Flag35
- -- Referenced_As_LHS Flag36
- -- Is_Known_Non_Null Flag37
- -- Can_Never_Be_Null Flag38
- -- Is_Overriding_Operation Flag39
- -- Body_Needed_For_SAL Flag40
-
- -- Treat_As_Volatile Flag41
- -- Is_Controlled Flag42
- -- Has_Controlled_Component Flag43
- -- Is_Pure Flag44
- -- In_Private_Part Flag45
- -- Has_Alignment_Clause Flag46
- -- Has_Exit Flag47
- -- In_Package_Body Flag48
- -- Reachable Flag49
- -- Delay_Subprogram_Descriptors Flag50
-
- -- Is_Packed Flag51
- -- Is_Entry_Formal Flag52
- -- Is_Private_Descendant Flag53
- -- Return_Present Flag54
- -- Is_Tagged_Type Flag55
- -- Has_Homonym Flag56
- -- Is_Hidden Flag57
- -- Non_Binary_Modulus Flag58
- -- Is_Preelaborated Flag59
- -- Is_Shared_Passive Flag60
-
- -- Is_Remote_Types Flag61
- -- Is_Remote_Call_Interface Flag62
- -- Is_Character_Type Flag63
- -- Is_Intrinsic_Subprogram Flag64
- -- Has_Record_Rep_Clause Flag65
- -- Has_Enumeration_Rep_Clause Flag66
- -- Has_Small_Clause Flag67
- -- Has_Component_Size_Clause Flag68
- -- Is_Access_Constant Flag69
- -- Is_First_Subtype Flag70
-
- -- Has_Completion_In_Body Flag71
- -- Has_Unknown_Discriminants Flag72
- -- Is_Child_Unit Flag73
- -- Is_CPP_Class Flag74
- -- Has_Non_Standard_Rep Flag75
- -- Is_Constructor Flag76
- -- Is_Thread_Body Flag77
- -- Is_Tag Flag78
- -- Has_All_Calls_Remote Flag79
- -- Is_Constr_Subt_For_U_Nominal Flag80
-
- -- Is_Asynchronous Flag81
- -- Has_Gigi_Rep_Item Flag82
- -- Has_Machine_Radix_Clause Flag83
- -- Machine_Radix_10 Flag84
- -- Is_Atomic Flag85
- -- Has_Atomic_Components Flag86
- -- Has_Volatile_Components Flag87
- -- Discard_Names Flag88
- -- Is_Interrupt_Handler Flag89
- -- Returns_By_Ref Flag90
-
- -- Is_Itype Flag91
- -- Size_Known_At_Compile_Time Flag92
- -- Has_Subprogram_Descriptor Flag93
- -- Is_Generic_Actual_Type Flag94
- -- Uses_Sec_Stack Flag95
- -- Warnings_Off Flag96
- -- Is_Controlling_Formal Flag97
- -- Has_Controlling_Result Flag98
- -- Is_Exported Flag99
- -- Has_Specified_Layout Flag100
-
- -- Has_Nested_Block_With_Handler Flag101
- -- Is_Called Flag102
- -- Is_Completely_Hidden Flag103
- -- Address_Taken Flag104
- -- Suppress_Init_Proc Flag105
- -- Is_Limited_Composite Flag106
- -- Is_Private_Composite Flag107
- -- Default_Expressions_Processed Flag108
- -- Is_Non_Static_Subtype Flag109
- -- Has_External_Tag_Rep_Clause Flag110
-
- -- Is_Formal_Subprogram Flag111
- -- Is_Renaming_Of_Object Flag112
- -- No_Return Flag113
- -- Delay_Cleanups Flag114
- -- Never_Set_In_Source Flag115
- -- Is_Visible_Child_Unit Flag116
- -- Is_Unchecked_Union Flag117
- -- Is_For_Access_Subtype Flag118
- -- Has_Convention_Pragma Flag119
- -- Has_Primitive_Operations Flag120
-
- -- Has_Pragma_Pack Flag121
- -- Is_Bit_Packed_Array Flag122
- -- Has_Unchecked_Union Flag123
- -- Is_Eliminated Flag124
- -- C_Pass_By_Copy Flag125
- -- Is_Instantiated Flag126
- -- Is_Valued_Procedure Flag127
- -- (used for Component_Alignment) Flag128
- -- (used for Component_Alignment) Flag129
- -- Is_Generic_Instance Flag130
-
- -- No_Pool_Assigned Flag131
- -- Is_AST_Entry Flag132
- -- Is_VMS_Exception Flag133
- -- Is_Optional_Parameter Flag134
- -- Has_Aliased_Components Flag135
- -- No_Strict_Aliasing Flag136
- -- Is_Machine_Code_Subprogram Flag137
- -- Is_Packed_Array_Type Flag138
- -- Has_Biased_Representation Flag139
- -- Has_Complex_Representation Flag140
-
- -- Is_Constr_Subt_For_UN_Aliased Flag141
- -- Has_Missing_Return Flag142
- -- Has_Recursive_Call Flag143
- -- Is_Unsigned_Type Flag144
- -- Strict_Alignment Flag145
- -- (unused) Flag146
- -- Needs_Debug_Info Flag147
- -- Suppress_Elaboration_Warnings Flag148
- -- Is_Compilation_Unit Flag149
- -- Has_Pragma_Elaborate_Body Flag150
-
- -- Vax_Float Flag151
- -- Entry_Accepted Flag152
- -- Is_Obsolescent Flag153
- -- Has_Per_Object_Constraint Flag154
- -- Has_Private_Declaration Flag155
- -- Referenced Flag156
- -- Has_Pragma_Inline Flag157
- -- Finalize_Storage_Only Flag158
- -- From_With_Type Flag159
- -- Is_Package_Body_Entity Flag160
-
- -- Has_Qualified_Name Flag161
- -- Nonzero_Is_True Flag162
- -- Is_True_Constant Flag163
- -- Reverse_Bit_Order Flag164
- -- Suppress_Style_Checks Flag165
- -- Debug_Info_Off Flag166
- -- Sec_Stack_Needed_For_Return Flag167
- -- Materialize_Entity Flag168
- -- Function_Returns_With_DSP Flag169
- -- Is_Known_Valid Flag170
-
- -- Is_Hidden_Open_Scope Flag171
- -- Has_Object_Size_Clause Flag172
- -- Has_Fully_Qualified_Name Flag173
- -- Elaboration_Entity_Required Flag174
- -- Has_Forward_Instantiation Flag175
- -- Is_Discrim_SO_Function Flag176
- -- Size_Depends_On_Discriminant Flag177
- -- Is_Null_Init_Proc Flag178
- -- Has_Pragma_Pure_Function Flag179
- -- Has_Pragma_Unreferenced Flag180
-
- -- Has_Contiguous_Rep Flag181
- -- Has_Xref_Entry Flag182
- -- Must_Be_On_Byte_Boundary Flag183
- -- Has_Stream_Size_Clause Flag184
- -- Is_Ada_2005_Only Flag185
- -- Is_Interface Flag186
- -- Has_Constrained_Partial_View Flag187
- -- Has_Persistent_BSS Flag188
- -- Is_Pure_Unit_Access_Type Flag189
- -- Has_Specified_Stream_Input Flag190
-
- -- Has_Specified_Stream_Output Flag191
- -- Has_Specified_Stream_Read Flag192
- -- Has_Specified_Stream_Write Flag193
- -- Is_Local_Anonymous_Access Flag194
- -- Is_Primitive_Wrapper Flag195
- -- Was_Hidden Flag196
- -- Is_Limited_Interface Flag197
- -- Is_Protected_Interface Flag198
- -- Is_Synchronized_Interface Flag199
- -- Is_Task_Interface Flag200
-
- -- Has_Anon_Block_Suffix Flag201
- -- Itype_Printed Flag202
- -- Has_Pragma_Pure Flag203
- -- Is_Known_Null Flag204
- -- Low_Bound_Known Flag205
- -- Is_Visible_Formal Flag206
- -- Known_To_Have_Preelab_Init Flag207
- -- Must_Have_Preelab_Init Flag208
- -- Is_Return_Object Flag209
- -- Elaborate_Body_Desirable Flag210
-
- -- Has_Static_Discriminants Flag211
-
- -- (unused) Flag212
- -- (unused) Flag213
- -- (unused) Flag214
- -- (unused) Flag215
+ -- Is_Frozen Flag4
+ -- Has_Discriminants Flag5
+ -- Is_Dispatching_Operation Flag6
+ -- Is_Immediately_Visible Flag7
+ -- In_Use Flag8
+ -- Is_Potentially_Use_Visible Flag9
+ -- Is_Public Flag10
+
+ -- Is_Inlined Flag11
+ -- Is_Constrained Flag12
+ -- Is_Generic_Type Flag13
+ -- Depends_On_Private Flag14
+ -- Is_Aliased Flag15
+ -- Is_Volatile Flag16
+ -- Is_Internal Flag17
+ -- Has_Delayed_Freeze Flag18
+ -- Is_Abstract_Subprogram Flag19
+ -- Is_Concurrent_Record_Type Flag20
+
+ -- Has_Master_Entity Flag21
+ -- Needs_No_Actuals Flag22
+ -- Has_Storage_Size_Clause Flag23
+ -- Is_Imported Flag24
+ -- Is_Limited_Record Flag25
+ -- Has_Completion Flag26
+ -- Has_Pragma_Controlled Flag27
+ -- Is_Statically_Allocated Flag28
+ -- Has_Size_Clause Flag29
+ -- Has_Task Flag30
+
+ -- Checks_May_Be_Suppressed Flag31
+ -- Kill_Elaboration_Checks Flag32
+ -- Kill_Range_Checks Flag33
+ -- Kill_Tag_Checks Flag34
+ -- Is_Class_Wide_Equivalent_Type Flag35
+ -- Referenced_As_LHS Flag36
+ -- Is_Known_Non_Null Flag37
+ -- Can_Never_Be_Null Flag38
+ -- Is_Overriding_Operation Flag39
+ -- Body_Needed_For_SAL Flag40
+
+ -- Treat_As_Volatile Flag41
+ -- Is_Controlled Flag42
+ -- Has_Controlled_Component Flag43
+ -- Is_Pure Flag44
+ -- In_Private_Part Flag45
+ -- Has_Alignment_Clause Flag46
+ -- Has_Exit Flag47
+ -- In_Package_Body Flag48
+ -- Reachable Flag49
+ -- Delay_Subprogram_Descriptors Flag50
+
+ -- Is_Packed Flag51
+ -- Is_Entry_Formal Flag52
+ -- Is_Private_Descendant Flag53
+ -- Return_Present Flag54
+ -- Is_Tagged_Type Flag55
+ -- Has_Homonym Flag56
+ -- Is_Hidden Flag57
+ -- Non_Binary_Modulus Flag58
+ -- Is_Preelaborated Flag59
+ -- Is_Shared_Passive Flag60
+
+ -- Is_Remote_Types Flag61
+ -- Is_Remote_Call_Interface Flag62
+ -- Is_Character_Type Flag63
+ -- Is_Intrinsic_Subprogram Flag64
+ -- Has_Record_Rep_Clause Flag65
+ -- Has_Enumeration_Rep_Clause Flag66
+ -- Has_Small_Clause Flag67
+ -- Has_Component_Size_Clause Flag68
+ -- Is_Access_Constant Flag69
+ -- Is_First_Subtype Flag70
+
+ -- Has_Completion_In_Body Flag71
+ -- Has_Unknown_Discriminants Flag72
+ -- Is_Child_Unit Flag73
+ -- Is_CPP_Class Flag74
+ -- Has_Non_Standard_Rep Flag75
+ -- Is_Constructor Flag76
+ -- Is_Thread_Body Flag77
+ -- Is_Tag Flag78
+ -- Has_All_Calls_Remote Flag79
+ -- Is_Constr_Subt_For_U_Nominal Flag80
+
+ -- Is_Asynchronous Flag81
+ -- Has_Gigi_Rep_Item Flag82
+ -- Has_Machine_Radix_Clause Flag83
+ -- Machine_Radix_10 Flag84
+ -- Is_Atomic Flag85
+ -- Has_Atomic_Components Flag86
+ -- Has_Volatile_Components Flag87
+ -- Discard_Names Flag88
+ -- Is_Interrupt_Handler Flag89
+ -- Returns_By_Ref Flag90
+
+ -- Is_Itype Flag91
+ -- Size_Known_At_Compile_Time Flag92
+ -- Has_Subprogram_Descriptor Flag93
+ -- Is_Generic_Actual_Type Flag94
+ -- Uses_Sec_Stack Flag95
+ -- Warnings_Off Flag96
+ -- Is_Controlling_Formal Flag97
+ -- Has_Controlling_Result Flag98
+ -- Is_Exported Flag99
+ -- Has_Specified_Layout Flag100
+
+ -- Has_Nested_Block_With_Handler Flag101
+ -- Is_Called Flag102
+ -- Is_Completely_Hidden Flag103
+ -- Address_Taken Flag104
+ -- Suppress_Init_Proc Flag105
+ -- Is_Limited_Composite Flag106
+ -- Is_Private_Composite Flag107
+ -- Default_Expressions_Processed Flag108
+ -- Is_Non_Static_Subtype Flag109
+ -- Has_External_Tag_Rep_Clause Flag110
+
+ -- Is_Formal_Subprogram Flag111
+ -- Is_Renaming_Of_Object Flag112
+ -- No_Return Flag113
+ -- Delay_Cleanups Flag114
+ -- Never_Set_In_Source Flag115
+ -- Is_Visible_Child_Unit Flag116
+ -- Is_Unchecked_Union Flag117
+ -- Is_For_Access_Subtype Flag118
+ -- Has_Convention_Pragma Flag119
+ -- Has_Primitive_Operations Flag120
+
+ -- Has_Pragma_Pack Flag121
+ -- Is_Bit_Packed_Array Flag122
+ -- Has_Unchecked_Union Flag123
+ -- Is_Eliminated Flag124
+ -- C_Pass_By_Copy Flag125
+ -- Is_Instantiated Flag126
+ -- Is_Valued_Procedure Flag127
+ -- (used for Component_Alignment) Flag128
+ -- (used for Component_Alignment) Flag129
+ -- Is_Generic_Instance Flag130
+
+ -- No_Pool_Assigned Flag131
+ -- Is_AST_Entry Flag132
+ -- Is_VMS_Exception Flag133
+ -- Is_Optional_Parameter Flag134
+ -- Has_Aliased_Components Flag135
+ -- No_Strict_Aliasing Flag136
+ -- Is_Machine_Code_Subprogram Flag137
+ -- Is_Packed_Array_Type Flag138
+ -- Has_Biased_Representation Flag139
+ -- Has_Complex_Representation Flag140
+
+ -- Is_Constr_Subt_For_UN_Aliased Flag141
+ -- Has_Missing_Return Flag142
+ -- Has_Recursive_Call Flag143
+ -- Is_Unsigned_Type Flag144
+ -- Strict_Alignment Flag145
+ -- Is_Abstract_Type Flag146
+ -- Needs_Debug_Info Flag147
+ -- Suppress_Elaboration_Warnings Flag148
+ -- Is_Compilation_Unit Flag149
+ -- Has_Pragma_Elaborate_Body Flag150
+
+ -- Vax_Float Flag151
+ -- Entry_Accepted Flag152
+ -- Is_Obsolescent Flag153
+ -- Has_Per_Object_Constraint Flag154
+ -- Has_Private_Declaration Flag155
+ -- Referenced Flag156
+ -- Has_Pragma_Inline Flag157
+ -- Finalize_Storage_Only Flag158
+ -- From_With_Type Flag159
+ -- Is_Package_Body_Entity Flag160
+
+ -- Has_Qualified_Name Flag161
+ -- Nonzero_Is_True Flag162
+ -- Is_True_Constant Flag163
+ -- Reverse_Bit_Order Flag164
+ -- Suppress_Style_Checks Flag165
+ -- Debug_Info_Off Flag166
+ -- Sec_Stack_Needed_For_Return Flag167
+ -- Materialize_Entity Flag168
+ -- Function_Returns_With_DSP Flag169
+ -- Is_Known_Valid Flag170
+
+ -- Is_Hidden_Open_Scope Flag171
+ -- Has_Object_Size_Clause Flag172
+ -- Has_Fully_Qualified_Name Flag173
+ -- Elaboration_Entity_Required Flag174
+ -- Has_Forward_Instantiation Flag175
+ -- Is_Discrim_SO_Function Flag176
+ -- Size_Depends_On_Discriminant Flag177
+ -- Is_Null_Init_Proc Flag178
+ -- Has_Pragma_Pure_Function Flag179
+ -- Has_Pragma_Unreferenced Flag180
+
+ -- Has_Contiguous_Rep Flag181
+ -- Has_Xref_Entry Flag182
+ -- Must_Be_On_Byte_Boundary Flag183
+ -- Has_Stream_Size_Clause Flag184
+ -- Is_Ada_2005_Only Flag185
+ -- Is_Interface Flag186
+ -- Has_Constrained_Partial_View Flag187
+ -- Has_Persistent_BSS Flag188
+ -- Is_Pure_Unit_Access_Type Flag189
+ -- Has_Specified_Stream_Input Flag190
+
+ -- Has_Specified_Stream_Output Flag191
+ -- Has_Specified_Stream_Read Flag192
+ -- Has_Specified_Stream_Write Flag193
+ -- Is_Local_Anonymous_Access Flag194
+ -- Is_Primitive_Wrapper Flag195
+ -- Was_Hidden Flag196
+ -- Is_Limited_Interface Flag197
+ -- Is_Protected_Interface Flag198
+ -- Is_Synchronized_Interface Flag199
+ -- Is_Task_Interface Flag200
+
+ -- Has_Anon_Block_Suffix Flag201
+ -- Itype_Printed Flag202
+ -- Has_Pragma_Pure Flag203
+ -- Is_Known_Null Flag204
+ -- Low_Bound_Known Flag205
+ -- Is_Visible_Formal Flag206
+ -- Known_To_Have_Preelab_Init Flag207
+ -- Must_Have_Preelab_Init Flag208
+ -- Is_Return_Object Flag209
+ -- Elaborate_Body_Desirable Flag210
+
+ -- Has_Static_Discriminants Flag211
+ -- Has_Pragma_Unreferenced_Objects Flag212
+ -- Requires_Overriding Flag213
+ -- Has_RACW Flag214
+
+ -- (unused) Flag215
-----------------------
-- Local subprograms --
function Abstract_Interfaces (Id : E) return L is
begin
- pragma Assert
- (Ekind (Id) = E_Record_Type
- or else Ekind (Id) = E_Record_Subtype
- or else Ekind (Id) = E_Record_Type_With_Private
- or else Ekind (Id) = E_Record_Subtype_With_Private
- or else Ekind (Id) = E_Class_Wide_Type);
+ pragma Assert (Is_Record_Type (Id));
return Elist25 (Id);
end Abstract_Interfaces;
function Equivalent_Type (Id : E) return E is
begin
pragma Assert
- (Ekind (Id) = E_Class_Wide_Subtype or else
- Ekind (Id) = E_Access_Protected_Subprogram_Type or else
- Ekind (Id) = E_Access_Subprogram_Type or else
+ (Ekind (Id) = E_Class_Wide_Subtype or else
+ Ekind (Id) = E_Access_Protected_Subprogram_Type or else
+ Ekind (Id) = E_Anonymous_Access_Protected_Subprogram_Type or else
+ Ekind (Id) = E_Access_Subprogram_Type or else
Ekind (Id) = E_Exception_Type);
return Node18 (Id);
end Equivalent_Type;
function First_Index (Id : E) return N is
begin
+ pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
return Node17 (Id);
end First_Index;
function First_Literal (Id : E) return E is
begin
+ pragma Assert (Is_Enumeration_Type (Id));
return Node17 (Id);
end First_Literal;
return Flag180 (Id);
end Has_Pragma_Unreferenced;
+ function Has_Pragma_Unreferenced_Objects (Id : E) return B is
+ begin
+ pragma Assert (Is_Type (Id));
+ return Flag212 (Id);
+ end Has_Pragma_Unreferenced_Objects;
+
function Has_Primitive_Operations (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
return Flag161 (Id);
end Has_Qualified_Name;
+ function Has_RACW (Id : E) return B is
+ begin
+ pragma Assert (Ekind (Id) = E_Package);
+ return Flag214 (Id);
+ end Has_RACW;
+
function Has_Record_Rep_Clause (Id : E) return B is
begin
pragma Assert (Is_Record_Type (Id));
return Node21 (Id);
end Interface_Name;
- function Is_Abstract (Id : E) return B is
+ function Is_Abstract_Subprogram (Id : E) return B is
begin
+ pragma Assert (Is_Overloadable (Id));
return Flag19 (Id);
- end Is_Abstract;
+ end Is_Abstract_Subprogram;
+
+ function Is_Abstract_Type (Id : E) return B is
+ begin
+ pragma Assert (Is_Type (Id));
+ return Flag146 (Id);
+ end Is_Abstract_Type;
function Is_Local_Anonymous_Access (Id : E) return B is
begin
function Master_Id (Id : E) return E is
begin
+ pragma Assert (Is_Access_Type (Id));
return Node17 (Id);
end Master_Id;
function Non_Limited_View (Id : E) return E is
begin
- pragma Assert (False
- or else Ekind (Id) in Incomplete_Kind);
+ pragma Assert (Ekind (Id) in Incomplete_Kind);
return Node17 (Id);
end Non_Limited_View;
return Uint9 (Id);
end Renaming_Map;
+ function Requires_Overriding (Id : E) return B is
+ begin
+ pragma Assert (Is_Overloadable (Id));
+ return Flag213 (Id);
+ end Requires_Overriding;
+
function Return_Present (Id : E) return B is
begin
return Flag54 (Id);
return Ekind (Id) in Access_Kind;
end Is_Access_Type;
+ function Is_Access_Protected_Subprogram_Type (Id : E) return B is
+ begin
+ return Ekind (Id) in Access_Protected_Kind;
+ end Is_Access_Protected_Subprogram_Type;
+
function Is_Array_Type (Id : E) return B is
begin
return Ekind (Id) in Array_Kind;
procedure Set_Abstract_Interfaces (Id : E; V : L) is
begin
- pragma Assert
- (Ekind (Id) = E_Record_Type
- or else Ekind (Id) = E_Record_Subtype
- or else Ekind (Id) = E_Record_Type_With_Private
- or else Ekind (Id) = E_Record_Subtype_With_Private
- or else Ekind (Id) = E_Class_Wide_Type);
+ pragma Assert (Is_Record_Type (Id));
Set_Elist25 (Id, V);
end Set_Abstract_Interfaces;
procedure Set_Equivalent_Type (Id : E; V : E) is
begin
pragma Assert
- (Ekind (Id) = E_Class_Wide_Type or else
- Ekind (Id) = E_Class_Wide_Subtype or else
- Ekind (Id) = E_Access_Protected_Subprogram_Type or else
- Ekind (Id) = E_Access_Subprogram_Type or else
+ (Ekind (Id) = E_Class_Wide_Type or else
+ Ekind (Id) = E_Class_Wide_Subtype or else
+ Ekind (Id) = E_Access_Protected_Subprogram_Type or else
+ Ekind (Id) = E_Anonymous_Access_Protected_Subprogram_Type or else
+ Ekind (Id) = E_Access_Subprogram_Type or else
Ekind (Id) = E_Exception_Type);
Set_Node18 (Id, V);
end Set_Equivalent_Type;
procedure Set_First_Index (Id : E; V : N) is
begin
+ pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
Set_Node17 (Id, V);
end Set_First_Index;
procedure Set_First_Literal (Id : E; V : E) is
begin
+ pragma Assert (Is_Enumeration_Type (Id));
Set_Node17 (Id, V);
end Set_First_Literal;
Set_Flag180 (Id, V);
end Set_Has_Pragma_Unreferenced;
+ procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Type (Id));
+ Set_Flag212 (Id, V);
+ end Set_Has_Pragma_Unreferenced_Objects;
+
procedure Set_Has_Primitive_Operations (Id : E; V : B := True) is
begin
pragma Assert (Id = Base_Type (Id));
Set_Flag161 (Id, V);
end Set_Has_Qualified_Name;
+ procedure Set_Has_RACW (Id : E; V : B := True) is
+ begin
+ pragma Assert (Ekind (Id) = E_Package);
+ Set_Flag214 (Id, V);
+ end Set_Has_RACW;
+
procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True) is
begin
pragma Assert (Id = Base_Type (Id));
Set_Node21 (Id, V);
end Set_Interface_Name;
- procedure Set_Is_Abstract (Id : E; V : B := True) is
+ procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True) is
begin
+ pragma Assert (Is_Overloadable (Id));
Set_Flag19 (Id, V);
- end Set_Is_Abstract;
+ end Set_Is_Abstract_Subprogram;
+
+ procedure Set_Is_Abstract_Type (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Type (Id));
+ Set_Flag146 (Id, V);
+ end Set_Is_Abstract_Type;
procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is
begin
procedure Set_Master_Id (Id : E; V : E) is
begin
+ pragma Assert (Is_Access_Type (Id));
Set_Node17 (Id, V);
end Set_Master_Id;
procedure Set_Non_Limited_View (Id : E; V : E) is
begin
- pragma Assert (False
- or else Ekind (Id) in Incomplete_Kind);
+ pragma Assert (Ekind (Id) in Incomplete_Kind);
Set_Node17 (Id, V);
end Set_Non_Limited_View;
Set_Uint9 (Id, V);
end Set_Renaming_Map;
+ procedure Set_Requires_Overriding (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Overloadable (Id));
+ Set_Flag213 (Id, V);
+ end Set_Requires_Overriding;
+
procedure Set_Return_Present (Id : E; V : B := True) is
begin
Set_Flag54 (Id, V);
end Entry_Index_Type;
---------------------
- -- 1 --
+ -- First_Component --
---------------------
function First_Component (Id : E) return E is
return Comp_Id;
end First_Component;
+ -------------------------------------
+ -- First_Component_Or_Discriminant --
+ -------------------------------------
+
+ function First_Component_Or_Discriminant (Id : E) return E is
+ Comp_Id : E;
+
+ begin
+ pragma Assert
+ (Is_Record_Type (Id) or else Is_Incomplete_Or_Private_Type (Id));
+
+ Comp_Id := First_Entity (Id);
+ while Present (Comp_Id) loop
+ exit when Ekind (Comp_Id) = E_Component
+ or else
+ Ekind (Comp_Id) = E_Discriminant;
+ Comp_Id := Next_Entity (Comp_Id);
+ end loop;
+
+ return Comp_Id;
+ end First_Component_Or_Discriminant;
+
------------------------
-- First_Discriminant --
------------------------
return Comp_Id;
end Next_Component;
+ ------------------------------------
+ -- Next_Component_Or_Discriminant --
+ ------------------------------------
+
+ function Next_Component_Or_Discriminant (Id : E) return E is
+ Comp_Id : E;
+
+ begin
+ Comp_Id := Next_Entity (Id);
+ while Present (Comp_Id) loop
+ exit when Ekind (Comp_Id) = E_Component
+ or else
+ Ekind (Comp_Id) = E_Discriminant;
+ Comp_Id := Next_Entity (Comp_Id);
+ end loop;
+
+ return Comp_Id;
+ end Next_Component_Or_Discriminant;
+
-----------------------
-- Next_Discriminant --
-----------------------
P : E;
begin
- -- Follow the chain of declared entities as long as the kind of
- -- the entity corresponds to a formal parameter. Skip internal
- -- entities that may have been created for implicit subtypes,
- -- in the process of analyzing default expressions.
+ -- Follow the chain of declared entities as long as the kind of the
+ -- entity corresponds to a formal parameter. Skip internal entities
+ -- that may have been created for implicit subtypes, in the process
+ -- of analyzing default expressions.
P := Id;
Write_Eol;
end if;
- W ("Address_Taken", Flag104 (Id));
- W ("Body_Needed_For_SAL", Flag40 (Id));
- W ("C_Pass_By_Copy", Flag125 (Id));
- W ("Can_Never_Be_Null", Flag38 (Id));
- W ("Checks_May_Be_Suppressed", Flag31 (Id));
- W ("Debug_Info_Off", Flag166 (Id));
- W ("Default_Expressions_Processed", Flag108 (Id));
- W ("Delay_Cleanups", Flag114 (Id));
- W ("Delay_Subprogram_Descriptors", Flag50 (Id));
- W ("Depends_On_Private", Flag14 (Id));
- W ("Discard_Names", Flag88 (Id));
- W ("Elaboration_Entity_Required", Flag174 (Id));
- W ("Elaborate_Body_Desirable", Flag210 (Id));
- W ("Entry_Accepted", Flag152 (Id));
- W ("Finalize_Storage_Only", Flag158 (Id));
- W ("From_With_Type", Flag159 (Id));
- W ("Function_Returns_With_DSP", Flag169 (Id));
- W ("Has_Aliased_Components", Flag135 (Id));
- W ("Has_Alignment_Clause", Flag46 (Id));
- W ("Has_All_Calls_Remote", Flag79 (Id));
- W ("Has_Anon_Block_Suffix", Flag201 (Id));
- W ("Has_Atomic_Components", Flag86 (Id));
- W ("Has_Biased_Representation", Flag139 (Id));
- W ("Has_Completion", Flag26 (Id));
- W ("Has_Completion_In_Body", Flag71 (Id));
- W ("Has_Complex_Representation", Flag140 (Id));
- W ("Has_Component_Size_Clause", Flag68 (Id));
- W ("Has_Contiguous_Rep", Flag181 (Id));
- W ("Has_Controlled_Component", Flag43 (Id));
- W ("Has_Controlling_Result", Flag98 (Id));
- W ("Has_Convention_Pragma", Flag119 (Id));
- W ("Has_Delayed_Freeze", Flag18 (Id));
- W ("Has_Discriminants", Flag5 (Id));
- W ("Has_Enumeration_Rep_Clause", Flag66 (Id));
- W ("Has_Exit", Flag47 (Id));
- W ("Has_External_Tag_Rep_Clause", Flag110 (Id));
- W ("Has_Forward_Instantiation", Flag175 (Id));
- W ("Has_Fully_Qualified_Name", Flag173 (Id));
- W ("Has_Gigi_Rep_Item", Flag82 (Id));
- W ("Has_Homonym", Flag56 (Id));
- W ("Has_Machine_Radix_Clause", Flag83 (Id));
- W ("Has_Master_Entity", Flag21 (Id));
- W ("Has_Missing_Return", Flag142 (Id));
- W ("Has_Nested_Block_With_Handler", Flag101 (Id));
- W ("Has_Non_Standard_Rep", Flag75 (Id));
- W ("Has_Object_Size_Clause", Flag172 (Id));
- W ("Has_Per_Object_Constraint", Flag154 (Id));
- W ("Has_Persistent_BSS", Flag188 (Id));
- W ("Has_Pragma_Controlled", Flag27 (Id));
- W ("Has_Pragma_Elaborate_Body", Flag150 (Id));
- W ("Has_Pragma_Inline", Flag157 (Id));
- W ("Has_Pragma_Pack", Flag121 (Id));
- W ("Has_Pragma_Pure", Flag203 (Id));
- W ("Has_Pragma_Pure_Function", Flag179 (Id));
- W ("Has_Pragma_Unreferenced", Flag180 (Id));
- W ("Has_Primitive_Operations", Flag120 (Id));
- W ("Has_Private_Declaration", Flag155 (Id));
- W ("Has_Qualified_Name", Flag161 (Id));
- W ("Has_Record_Rep_Clause", Flag65 (Id));
- W ("Has_Recursive_Call", Flag143 (Id));
- W ("Has_Size_Clause", Flag29 (Id));
- W ("Has_Small_Clause", Flag67 (Id));
- W ("Has_Specified_Layout", Flag100 (Id));
- W ("Has_Specified_Stream_Input", Flag190 (Id));
- W ("Has_Specified_Stream_Output", Flag191 (Id));
- W ("Has_Specified_Stream_Read", Flag192 (Id));
- W ("Has_Specified_Stream_Write", Flag193 (Id));
- W ("Has_Static_Discriminants", Flag211 (Id));
- W ("Has_Storage_Size_Clause", Flag23 (Id));
- W ("Has_Stream_Size_Clause", Flag184 (Id));
- W ("Has_Subprogram_Descriptor", Flag93 (Id));
- W ("Has_Task", Flag30 (Id));
- W ("Has_Unchecked_Union", Flag123 (Id));
- W ("Has_Unknown_Discriminants", Flag72 (Id));
- W ("Has_Volatile_Components", Flag87 (Id));
- W ("Has_Xref_Entry", Flag182 (Id));
- W ("In_Package_Body", Flag48 (Id));
- W ("In_Private_Part", Flag45 (Id));
- W ("In_Use", Flag8 (Id));
- W ("Is_AST_Entry", Flag132 (Id));
- W ("Is_Abstract", Flag19 (Id));
- W ("Is_Local_Anonymous_Access", Flag194 (Id));
- W ("Is_Access_Constant", Flag69 (Id));
- W ("Is_Ada_2005_Only", Flag185 (Id));
- W ("Is_Aliased", Flag15 (Id));
- W ("Is_Asynchronous", Flag81 (Id));
- W ("Is_Atomic", Flag85 (Id));
- W ("Is_Bit_Packed_Array", Flag122 (Id));
- W ("Is_CPP_Class", Flag74 (Id));
- W ("Is_Called", Flag102 (Id));
- W ("Is_Character_Type", Flag63 (Id));
- W ("Is_Child_Unit", Flag73 (Id));
- W ("Is_Class_Wide_Equivalent_Type", Flag35 (Id));
- W ("Is_Compilation_Unit", Flag149 (Id));
- W ("Is_Completely_Hidden", Flag103 (Id));
- W ("Is_Concurrent_Record_Type", Flag20 (Id));
- W ("Is_Constr_Subt_For_UN_Aliased", Flag141 (Id));
- W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id));
- W ("Is_Constrained", Flag12 (Id));
- W ("Is_Constructor", Flag76 (Id));
- W ("Is_Controlled", Flag42 (Id));
- W ("Is_Controlling_Formal", Flag97 (Id));
- W ("Is_Discrim_SO_Function", Flag176 (Id));
- W ("Is_Dispatching_Operation", Flag6 (Id));
- W ("Is_Eliminated", Flag124 (Id));
- W ("Is_Entry_Formal", Flag52 (Id));
- W ("Is_Exported", Flag99 (Id));
- W ("Is_First_Subtype", Flag70 (Id));
- W ("Is_For_Access_Subtype", Flag118 (Id));
- W ("Is_Formal_Subprogram", Flag111 (Id));
- W ("Is_Frozen", Flag4 (Id));
- W ("Is_Generic_Actual_Type", Flag94 (Id));
- W ("Is_Generic_Instance", Flag130 (Id));
- W ("Is_Generic_Type", Flag13 (Id));
- W ("Is_Hidden", Flag57 (Id));
- W ("Is_Hidden_Open_Scope", Flag171 (Id));
- W ("Is_Immediately_Visible", Flag7 (Id));
- W ("Is_Imported", Flag24 (Id));
- W ("Is_Inlined", Flag11 (Id));
- W ("Is_Instantiated", Flag126 (Id));
- W ("Is_Interface", Flag186 (Id));
- W ("Is_Internal", Flag17 (Id));
- W ("Is_Interrupt_Handler", Flag89 (Id));
- W ("Is_Intrinsic_Subprogram", Flag64 (Id));
- W ("Is_Itype", Flag91 (Id));
- W ("Is_Known_Non_Null", Flag37 (Id));
- W ("Is_Known_Null", Flag204 (Id));
- W ("Is_Known_Valid", Flag170 (Id));
- W ("Is_Limited_Composite", Flag106 (Id));
- W ("Is_Limited_Interface", Flag197 (Id));
- W ("Is_Limited_Record", Flag25 (Id));
- W ("Is_Machine_Code_Subprogram", Flag137 (Id));
- W ("Is_Non_Static_Subtype", Flag109 (Id));
- W ("Is_Null_Init_Proc", Flag178 (Id));
- W ("Is_Obsolescent", Flag153 (Id));
- W ("Is_Optional_Parameter", Flag134 (Id));
- W ("Is_Overriding_Operation", Flag39 (Id));
- W ("Is_Package_Body_Entity", Flag160 (Id));
- W ("Is_Packed", Flag51 (Id));
- W ("Is_Packed_Array_Type", Flag138 (Id));
- W ("Is_Potentially_Use_Visible", Flag9 (Id));
- W ("Is_Preelaborated", Flag59 (Id));
- W ("Is_Primitive_Wrapper", Flag195 (Id));
- W ("Is_Private_Composite", Flag107 (Id));
- W ("Is_Private_Descendant", Flag53 (Id));
- W ("Is_Protected_Interface", Flag198 (Id));
- W ("Is_Public", Flag10 (Id));
- W ("Is_Pure", Flag44 (Id));
- W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
- W ("Is_Remote_Call_Interface", Flag62 (Id));
- W ("Is_Remote_Types", Flag61 (Id));
- W ("Is_Renaming_Of_Object", Flag112 (Id));
- W ("Is_Return_Object", Flag209 (Id));
- W ("Is_Shared_Passive", Flag60 (Id));
- W ("Is_Synchronized_Interface", Flag199 (Id));
- W ("Is_Statically_Allocated", Flag28 (Id));
- W ("Is_Tag", Flag78 (Id));
- W ("Is_Tagged_Type", Flag55 (Id));
- W ("Is_Task_Interface", Flag200 (Id));
- W ("Is_Thread_Body", Flag77 (Id));
- W ("Is_True_Constant", Flag163 (Id));
- W ("Is_Unchecked_Union", Flag117 (Id));
- W ("Is_Unsigned_Type", Flag144 (Id));
- W ("Is_VMS_Exception", Flag133 (Id));
- W ("Is_Valued_Procedure", Flag127 (Id));
- W ("Is_Visible_Child_Unit", Flag116 (Id));
- W ("Is_Visible_Formal", Flag206 (Id));
- W ("Is_Volatile", Flag16 (Id));
- W ("Itype_Printed", Flag202 (Id));
- W ("Kill_Elaboration_Checks", Flag32 (Id));
- W ("Kill_Range_Checks", Flag33 (Id));
- W ("Kill_Tag_Checks", Flag34 (Id));
- W ("Known_To_Have_Preelab_Init", Flag207 (Id));
- W ("Low_Bound_Known", Flag205 (Id));
- W ("Machine_Radix_10", Flag84 (Id));
- W ("Materialize_Entity", Flag168 (Id));
- W ("Must_Be_On_Byte_Boundary", Flag183 (Id));
- W ("Must_Have_Preelab_Init", Flag208 (Id));
- W ("Needs_Debug_Info", Flag147 (Id));
- W ("Needs_No_Actuals", Flag22 (Id));
- W ("Never_Set_In_Source", Flag115 (Id));
- W ("No_Pool_Assigned", Flag131 (Id));
- W ("No_Return", Flag113 (Id));
- W ("No_Strict_Aliasing", Flag136 (Id));
- W ("Non_Binary_Modulus", Flag58 (Id));
- W ("Nonzero_Is_True", Flag162 (Id));
- W ("Reachable", Flag49 (Id));
- W ("Referenced", Flag156 (Id));
- W ("Referenced_As_LHS", Flag36 (Id));
- W ("Return_Present", Flag54 (Id));
- W ("Returns_By_Ref", Flag90 (Id));
- W ("Reverse_Bit_Order", Flag164 (Id));
- W ("Sec_Stack_Needed_For_Return", Flag167 (Id));
- W ("Size_Depends_On_Discriminant", Flag177 (Id));
- W ("Size_Known_At_Compile_Time", Flag92 (Id));
- W ("Strict_Alignment", Flag145 (Id));
- W ("Suppress_Elaboration_Warnings", Flag148 (Id));
- W ("Suppress_Init_Proc", Flag105 (Id));
- W ("Suppress_Style_Checks", Flag165 (Id));
- W ("Treat_As_Volatile", Flag41 (Id));
- W ("Uses_Sec_Stack", Flag95 (Id));
- W ("Vax_Float", Flag151 (Id));
- W ("Warnings_Off", Flag96 (Id));
- W ("Was_Hidden", Flag196 (Id));
+ W ("Address_Taken", Flag104 (Id));
+ W ("Body_Needed_For_SAL", Flag40 (Id));
+ W ("C_Pass_By_Copy", Flag125 (Id));
+ W ("Can_Never_Be_Null", Flag38 (Id));
+ W ("Checks_May_Be_Suppressed", Flag31 (Id));
+ W ("Debug_Info_Off", Flag166 (Id));
+ W ("Default_Expressions_Processed", Flag108 (Id));
+ W ("Delay_Cleanups", Flag114 (Id));
+ W ("Delay_Subprogram_Descriptors", Flag50 (Id));
+ W ("Depends_On_Private", Flag14 (Id));
+ W ("Discard_Names", Flag88 (Id));
+ W ("Elaboration_Entity_Required", Flag174 (Id));
+ W ("Elaborate_Body_Desirable", Flag210 (Id));
+ W ("Entry_Accepted", Flag152 (Id));
+ W ("Finalize_Storage_Only", Flag158 (Id));
+ W ("From_With_Type", Flag159 (Id));
+ W ("Function_Returns_With_DSP", Flag169 (Id));
+ W ("Has_Aliased_Components", Flag135 (Id));
+ W ("Has_Alignment_Clause", Flag46 (Id));
+ W ("Has_All_Calls_Remote", Flag79 (Id));
+ W ("Has_Anon_Block_Suffix", Flag201 (Id));
+ W ("Has_Atomic_Components", Flag86 (Id));
+ W ("Has_Biased_Representation", Flag139 (Id));
+ W ("Has_Completion", Flag26 (Id));
+ W ("Has_Completion_In_Body", Flag71 (Id));
+ W ("Has_Complex_Representation", Flag140 (Id));
+ W ("Has_Component_Size_Clause", Flag68 (Id));
+ W ("Has_Contiguous_Rep", Flag181 (Id));
+ W ("Has_Controlled_Component", Flag43 (Id));
+ W ("Has_Controlling_Result", Flag98 (Id));
+ W ("Has_Convention_Pragma", Flag119 (Id));
+ W ("Has_Delayed_Freeze", Flag18 (Id));
+ W ("Has_Discriminants", Flag5 (Id));
+ W ("Has_Enumeration_Rep_Clause", Flag66 (Id));
+ W ("Has_Exit", Flag47 (Id));
+ W ("Has_External_Tag_Rep_Clause", Flag110 (Id));
+ W ("Has_Forward_Instantiation", Flag175 (Id));
+ W ("Has_Fully_Qualified_Name", Flag173 (Id));
+ W ("Has_Gigi_Rep_Item", Flag82 (Id));
+ W ("Has_Homonym", Flag56 (Id));
+ W ("Has_Machine_Radix_Clause", Flag83 (Id));
+ W ("Has_Master_Entity", Flag21 (Id));
+ W ("Has_Missing_Return", Flag142 (Id));
+ W ("Has_Nested_Block_With_Handler", Flag101 (Id));
+ W ("Has_Non_Standard_Rep", Flag75 (Id));
+ W ("Has_Object_Size_Clause", Flag172 (Id));
+ W ("Has_Per_Object_Constraint", Flag154 (Id));
+ W ("Has_Persistent_BSS", Flag188 (Id));
+ W ("Has_Pragma_Controlled", Flag27 (Id));
+ W ("Has_Pragma_Elaborate_Body", Flag150 (Id));
+ W ("Has_Pragma_Inline", Flag157 (Id));
+ W ("Has_Pragma_Pack", Flag121 (Id));
+ W ("Has_Pragma_Pure", Flag203 (Id));
+ W ("Has_Pragma_Pure_Function", Flag179 (Id));
+ W ("Has_Pragma_Unreferenced", Flag180 (Id));
+ W ("Has_Pragma_Unreferenced_Objects", Flag212 (Id));
+ W ("Has_Primitive_Operations", Flag120 (Id));
+ W ("Has_Private_Declaration", Flag155 (Id));
+ W ("Has_Qualified_Name", Flag161 (Id));
+ W ("Has_RACW", Flag214 (Id));
+ W ("Has_Record_Rep_Clause", Flag65 (Id));
+ W ("Has_Recursive_Call", Flag143 (Id));
+ W ("Has_Size_Clause", Flag29 (Id));
+ W ("Has_Small_Clause", Flag67 (Id));
+ W ("Has_Specified_Layout", Flag100 (Id));
+ W ("Has_Specified_Stream_Input", Flag190 (Id));
+ W ("Has_Specified_Stream_Output", Flag191 (Id));
+ W ("Has_Specified_Stream_Read", Flag192 (Id));
+ W ("Has_Specified_Stream_Write", Flag193 (Id));
+ W ("Has_Static_Discriminants", Flag211 (Id));
+ W ("Has_Storage_Size_Clause", Flag23 (Id));
+ W ("Has_Stream_Size_Clause", Flag184 (Id));
+ W ("Has_Subprogram_Descriptor", Flag93 (Id));
+ W ("Has_Task", Flag30 (Id));
+ W ("Has_Unchecked_Union", Flag123 (Id));
+ W ("Has_Unknown_Discriminants", Flag72 (Id));
+ W ("Has_Volatile_Components", Flag87 (Id));
+ W ("Has_Xref_Entry", Flag182 (Id));
+ W ("In_Package_Body", Flag48 (Id));
+ W ("In_Private_Part", Flag45 (Id));
+ W ("In_Use", Flag8 (Id));
+ W ("Is_AST_Entry", Flag132 (Id));
+ W ("Is_Abstract_Subprogram", Flag19 (Id));
+ W ("Is_Abstract_Type", Flag146 (Id));
+ W ("Is_Local_Anonymous_Access", Flag194 (Id));
+ W ("Is_Access_Constant", Flag69 (Id));
+ W ("Is_Ada_2005_Only", Flag185 (Id));
+ W ("Is_Aliased", Flag15 (Id));
+ W ("Is_Asynchronous", Flag81 (Id));
+ W ("Is_Atomic", Flag85 (Id));
+ W ("Is_Bit_Packed_Array", Flag122 (Id));
+ W ("Is_CPP_Class", Flag74 (Id));
+ W ("Is_Called", Flag102 (Id));
+ W ("Is_Character_Type", Flag63 (Id));
+ W ("Is_Child_Unit", Flag73 (Id));
+ W ("Is_Class_Wide_Equivalent_Type", Flag35 (Id));
+ W ("Is_Compilation_Unit", Flag149 (Id));
+ W ("Is_Completely_Hidden", Flag103 (Id));
+ W ("Is_Concurrent_Record_Type", Flag20 (Id));
+ W ("Is_Constr_Subt_For_UN_Aliased", Flag141 (Id));
+ W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id));
+ W ("Is_Constrained", Flag12 (Id));
+ W ("Is_Constructor", Flag76 (Id));
+ W ("Is_Controlled", Flag42 (Id));
+ W ("Is_Controlling_Formal", Flag97 (Id));
+ W ("Is_Discrim_SO_Function", Flag176 (Id));
+ W ("Is_Dispatching_Operation", Flag6 (Id));
+ W ("Is_Eliminated", Flag124 (Id));
+ W ("Is_Entry_Formal", Flag52 (Id));
+ W ("Is_Exported", Flag99 (Id));
+ W ("Is_First_Subtype", Flag70 (Id));
+ W ("Is_For_Access_Subtype", Flag118 (Id));
+ W ("Is_Formal_Subprogram", Flag111 (Id));
+ W ("Is_Frozen", Flag4 (Id));
+ W ("Is_Generic_Actual_Type", Flag94 (Id));
+ W ("Is_Generic_Instance", Flag130 (Id));
+ W ("Is_Generic_Type", Flag13 (Id));
+ W ("Is_Hidden", Flag57 (Id));
+ W ("Is_Hidden_Open_Scope", Flag171 (Id));
+ W ("Is_Immediately_Visible", Flag7 (Id));
+ W ("Is_Imported", Flag24 (Id));
+ W ("Is_Inlined", Flag11 (Id));
+ W ("Is_Instantiated", Flag126 (Id));
+ W ("Is_Interface", Flag186 (Id));
+ W ("Is_Internal", Flag17 (Id));
+ W ("Is_Interrupt_Handler", Flag89 (Id));
+ W ("Is_Intrinsic_Subprogram", Flag64 (Id));
+ W ("Is_Itype", Flag91 (Id));
+ W ("Is_Known_Non_Null", Flag37 (Id));
+ W ("Is_Known_Null", Flag204 (Id));
+ W ("Is_Known_Valid", Flag170 (Id));
+ W ("Is_Limited_Composite", Flag106 (Id));
+ W ("Is_Limited_Interface", Flag197 (Id));
+ W ("Is_Limited_Record", Flag25 (Id));
+ W ("Is_Machine_Code_Subprogram", Flag137 (Id));
+ W ("Is_Non_Static_Subtype", Flag109 (Id));
+ W ("Is_Null_Init_Proc", Flag178 (Id));
+ W ("Is_Obsolescent", Flag153 (Id));
+ W ("Is_Optional_Parameter", Flag134 (Id));
+ W ("Is_Overriding_Operation", Flag39 (Id));
+ W ("Is_Package_Body_Entity", Flag160 (Id));
+ W ("Is_Packed", Flag51 (Id));
+ W ("Is_Packed_Array_Type", Flag138 (Id));
+ W ("Is_Potentially_Use_Visible", Flag9 (Id));
+ W ("Is_Preelaborated", Flag59 (Id));
+ W ("Is_Primitive_Wrapper", Flag195 (Id));
+ W ("Is_Private_Composite", Flag107 (Id));
+ W ("Is_Private_Descendant", Flag53 (Id));
+ W ("Is_Protected_Interface", Flag198 (Id));
+ W ("Is_Public", Flag10 (Id));
+ W ("Is_Pure", Flag44 (Id));
+ W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
+ W ("Is_Remote_Call_Interface", Flag62 (Id));
+ W ("Is_Remote_Types", Flag61 (Id));
+ W ("Is_Renaming_Of_Object", Flag112 (Id));
+ W ("Is_Return_Object", Flag209 (Id));
+ W ("Is_Shared_Passive", Flag60 (Id));
+ W ("Is_Synchronized_Interface", Flag199 (Id));
+ W ("Is_Statically_Allocated", Flag28 (Id));
+ W ("Is_Tag", Flag78 (Id));
+ W ("Is_Tagged_Type", Flag55 (Id));
+ W ("Is_Task_Interface", Flag200 (Id));
+ W ("Is_Thread_Body", Flag77 (Id));
+ W ("Is_True_Constant", Flag163 (Id));
+ W ("Is_Unchecked_Union", Flag117 (Id));
+ W ("Is_Unsigned_Type", Flag144 (Id));
+ W ("Is_VMS_Exception", Flag133 (Id));
+ W ("Is_Valued_Procedure", Flag127 (Id));
+ W ("Is_Visible_Child_Unit", Flag116 (Id));
+ W ("Is_Visible_Formal", Flag206 (Id));
+ W ("Is_Volatile", Flag16 (Id));
+ W ("Itype_Printed", Flag202 (Id));
+ W ("Kill_Elaboration_Checks", Flag32 (Id));
+ W ("Kill_Range_Checks", Flag33 (Id));
+ W ("Kill_Tag_Checks", Flag34 (Id));
+ W ("Known_To_Have_Preelab_Init", Flag207 (Id));
+ W ("Low_Bound_Known", Flag205 (Id));
+ W ("Machine_Radix_10", Flag84 (Id));
+ W ("Materialize_Entity", Flag168 (Id));
+ W ("Must_Be_On_Byte_Boundary", Flag183 (Id));
+ W ("Must_Have_Preelab_Init", Flag208 (Id));
+ W ("Needs_Debug_Info", Flag147 (Id));
+ W ("Needs_No_Actuals", Flag22 (Id));
+ W ("Never_Set_In_Source", Flag115 (Id));
+ W ("No_Pool_Assigned", Flag131 (Id));
+ W ("No_Return", Flag113 (Id));
+ W ("No_Strict_Aliasing", Flag136 (Id));
+ W ("Non_Binary_Modulus", Flag58 (Id));
+ W ("Nonzero_Is_True", Flag162 (Id));
+ W ("Reachable", Flag49 (Id));
+ W ("Referenced", Flag156 (Id));
+ W ("Referenced_As_LHS", Flag36 (Id));
+ W ("Requires_Overriding", Flag213 (Id));
+ W ("Return_Present", Flag54 (Id));
+ W ("Returns_By_Ref", Flag90 (Id));
+ W ("Reverse_Bit_Order", Flag164 (Id));
+ W ("Sec_Stack_Needed_For_Return", Flag167 (Id));
+ W ("Size_Depends_On_Discriminant", Flag177 (Id));
+ W ("Size_Known_At_Compile_Time", Flag92 (Id));
+ W ("Strict_Alignment", Flag145 (Id));
+ W ("Suppress_Elaboration_Warnings", Flag148 (Id));
+ W ("Suppress_Init_Proc", Flag105 (Id));
+ W ("Suppress_Style_Checks", Flag165 (Id));
+ W ("Treat_As_Volatile", Flag41 (Id));
+ W ("Uses_Sec_Stack", Flag95 (Id));
+ W ("Vax_Float", Flag151 (Id));
+ W ("Warnings_Off", Flag96 (Id));
+ W ("Was_Hidden", Flag196 (Id));
end Write_Entity_Flags;
-----------------------
procedure Write_Field8_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Component |
- E_Discriminant =>
+ when E_Component |
+ E_Discriminant =>
Write_Str ("Normalized_First_Bit");
- when Formal_Kind |
- E_Function |
- E_Subprogram_Body =>
+ when Formal_Kind |
+ E_Function |
+ E_Subprogram_Body =>
Write_Str ("Mechanism");
- when Type_Kind =>
+ when Type_Kind =>
Write_Str ("Associated_Node_For_Itype");
- when E_Package =>
+ when E_Package =>
Write_Str ("Dependent_Instances");
- when E_Return_Statement =>
+ when E_Return_Statement =>
Write_Str ("Return_Applies_To");
- when E_Variable =>
+ when E_Variable =>
Write_Str ("Hiding_Loop_Variable");
- when others =>
+ when others =>
Write_Str ("Field8??");
end case;
end Write_Field8_Name;
procedure Write_Field9_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Type_Kind =>
+ when Type_Kind =>
Write_Str ("Class_Wide_Type");
- when E_Function |
- E_Generic_Function |
- E_Generic_Package |
- E_Generic_Procedure |
- E_Package |
- E_Procedure =>
+ when E_Function |
+ E_Generic_Function |
+ E_Generic_Package |
+ E_Generic_Procedure |
+ E_Package |
+ E_Procedure =>
Write_Str ("Renaming_Map");
- when Object_Kind =>
+ when Object_Kind =>
Write_Str ("Current_Value");
- when others =>
+ when others =>
Write_Str ("Field9??");
end case;
end Write_Field9_Name;
procedure Write_Field10_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Type_Kind =>
+ when Type_Kind =>
Write_Str ("Referenced_Object");
- when E_In_Parameter |
- E_Constant =>
+ when E_In_Parameter |
+ E_Constant =>
Write_Str ("Discriminal_Link");
- when E_Function |
- E_Package |
- E_Package_Body |
- E_Procedure =>
+ when E_Function |
+ E_Package |
+ E_Package_Body |
+ E_Procedure =>
Write_Str ("Handler_Records");
- when E_Component |
- E_Discriminant =>
+ when E_Component |
+ E_Discriminant =>
Write_Str ("Normalized_Position_Max");
- when others =>
+ when others =>
Write_Str ("Field10??");
end case;
end Write_Field10_Name;
procedure Write_Field11_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Formal_Kind =>
+ when Formal_Kind =>
Write_Str ("Entry_Component");
- when E_Component |
- E_Discriminant =>
+ when E_Component |
+ E_Discriminant =>
Write_Str ("Component_Bit_Offset");
- when E_Constant =>
+ when E_Constant =>
Write_Str ("Full_View");
- when E_Enumeration_Literal =>
+ when E_Enumeration_Literal =>
Write_Str ("Enumeration_Pos");
- when E_Block =>
+ when E_Block =>
Write_Str ("Block_Node");
- when E_Function |
- E_Procedure |
- E_Entry |
- E_Entry_Family =>
+ when E_Function |
+ E_Procedure |
+ E_Entry |
+ E_Entry_Family =>
Write_Str ("Protected_Body_Subprogram");
- when E_Generic_Package =>
+ when E_Generic_Package =>
Write_Str ("Generic_Homonym");
- when Type_Kind =>
+ when Type_Kind =>
Write_Str ("Full_View");
- when others =>
+ when others =>
Write_Str ("Field11??");
end case;
end Write_Field11_Name;
procedure Write_Field12_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Entry_Kind =>
+ when Entry_Kind =>
Write_Str ("Barrier_Function");
- when E_Enumeration_Literal =>
+ when E_Enumeration_Literal =>
Write_Str ("Enumeration_Rep");
- when Type_Kind |
- E_Component |
- E_Constant |
- E_Discriminant |
- E_In_Parameter |
- E_In_Out_Parameter |
- E_Out_Parameter |
- E_Loop_Parameter |
- E_Variable =>
+ when Type_Kind |
+ E_Component |
+ E_Constant |
+ E_Discriminant |
+ E_In_Parameter |
+ E_In_Out_Parameter |
+ E_Out_Parameter |
+ E_Loop_Parameter |
+ E_Variable =>
Write_Str ("Esize");
- when E_Function |
- E_Procedure =>
+ when E_Function |
+ E_Procedure =>
Write_Str ("Next_Inlined_Subprogram");
- when E_Package =>
+ when E_Package =>
Write_Str ("Associated_Formal_Package");
- when others =>
+ when others =>
Write_Str ("Field12??");
end case;
end Write_Field12_Name;
procedure Write_Field13_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Type_Kind =>
+ when Type_Kind =>
Write_Str ("RM_Size");
- when E_Component |
- E_Discriminant =>
+ when E_Component |
+ E_Discriminant =>
Write_Str ("Component_Clause");
- when E_Enumeration_Literal =>
+ when E_Enumeration_Literal =>
Write_Str ("Debug_Renaming_Link");
- when E_Function =>
+ when E_Function =>
if not Comes_From_Source (Id)
and then
Chars (Id) = Name_Op_Ne
Write_Str ("Field13??");
end if;
- when Formal_Kind |
- E_Variable =>
+ when Formal_Kind |
+ E_Variable =>
Write_Str ("Extra_Accessibility");
- when E_Procedure |
- E_Package |
- Generic_Unit_Kind =>
+ when E_Procedure |
+ E_Package |
+ Generic_Unit_Kind =>
Write_Str ("Elaboration_Entity");
- when others =>
+ when others =>
Write_Str ("Field13??");
end case;
end Write_Field13_Name;
procedure Write_Field14_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Type_Kind |
- Formal_Kind |
- E_Constant |
- E_Variable |
- E_Loop_Parameter =>
+ when Type_Kind |
+ Formal_Kind |
+ E_Constant |
+ E_Variable |
+ E_Loop_Parameter =>
Write_Str ("Alignment");
- when E_Component |
- E_Discriminant =>
+ when E_Component |
+ E_Discriminant =>
Write_Str ("Normalized_Position");
- when E_Function |
- E_Procedure =>
+ when E_Function |
+ E_Procedure =>
Write_Str ("First_Optional_Parameter");
- when E_Package |
- E_Generic_Package =>
+ when E_Package |
+ E_Generic_Package =>
Write_Str ("Shadow_Entities");
- when others =>
+ when others =>
Write_Str ("Field14??");
end case;
end Write_Field14_Name;
procedure Write_Field15_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Access_Kind |
- Task_Kind =>
+ when Access_Kind |
+ Task_Kind =>
Write_Str ("Storage_Size_Variable");
- when Class_Wide_Kind |
- E_Record_Type |
- E_Record_Subtype |
- Private_Kind =>
+ when Class_Wide_Kind |
+ E_Record_Type |
+ E_Record_Subtype |
+ Private_Kind =>
Write_Str ("Primitive_Operations");
- when E_Component =>
+ when E_Component =>
Write_Str ("DT_Entry_Count");
- when Decimal_Fixed_Point_Kind =>
+ when Decimal_Fixed_Point_Kind =>
Write_Str ("Scale_Value");
- when E_Discriminant =>
+ when E_Discriminant =>
Write_Str ("Discriminant_Number");
- when Formal_Kind =>
+ when Formal_Kind =>
Write_Str ("Extra_Formal");
- when E_Function |
- E_Procedure =>
+ when E_Function |
+ E_Procedure =>
Write_Str ("DT_Position");
- when Entry_Kind =>
+ when Entry_Kind =>
Write_Str ("Entry_Parameters_Type");
- when Enumeration_Kind =>
+ when Enumeration_Kind =>
Write_Str ("Lit_Indexes");
- when E_Package |
- E_Package_Body =>
+ when E_Package |
+ E_Package_Body =>
Write_Str ("Related_Instance");
- when E_Protected_Type =>
+ when E_Protected_Type =>
Write_Str ("Entry_Bodies_Array");
- when E_String_Literal_Subtype =>
+ when E_String_Literal_Subtype =>
Write_Str ("String_Literal_Low_Bound");
- when E_Variable =>
+ when E_Variable =>
Write_Str ("Shared_Var_Read_Proc");
- when others =>
+ when others =>
Write_Str ("Field15??");
end case;
end Write_Field15_Name;
procedure Write_Field16_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Component =>
+ when E_Component =>
Write_Str ("Entry_Formal");
- when E_Function |
- E_Procedure =>
+ when E_Function |
+ E_Procedure =>
Write_Str ("DTC_Entity");
- when E_Package |
- E_Generic_Package |
- Concurrent_Kind =>
+ when E_Package |
+ E_Generic_Package |
+ Concurrent_Kind =>
Write_Str ("First_Private_Entity");
- when E_Record_Type |
- E_Record_Type_With_Private =>
+ when E_Record_Type |
+ E_Record_Type_With_Private =>
Write_Str ("Access_Disp_Table");
- when E_String_Literal_Subtype =>
+ when E_String_Literal_Subtype =>
Write_Str ("String_Literal_Length");
- when Enumeration_Kind =>
+ when Enumeration_Kind =>
Write_Str ("Lit_Strings");
- when E_Variable |
- E_Out_Parameter =>
+ when E_Variable |
+ E_Out_Parameter =>
Write_Str ("Unset_Reference");
- when E_Record_Subtype |
- E_Class_Wide_Subtype =>
+ when E_Record_Subtype |
+ E_Class_Wide_Subtype =>
Write_Str ("Cloned_Subtype");
- when others =>
+ when others =>
Write_Str ("Field16??");
end case;
end Write_Field16_Name;
procedure Write_Field17_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Digits_Kind =>
+ when Digits_Kind =>
Write_Str ("Digits_Value");
- when E_Component =>
+ when E_Component =>
Write_Str ("Prival");
- when E_Discriminant =>
+ when E_Discriminant =>
Write_Str ("Discriminal");
- when E_Block |
- Class_Wide_Kind |
- Concurrent_Kind |
- Private_Kind |
- E_Entry |
- E_Entry_Family |
- E_Function |
- E_Generic_Function |
- E_Generic_Package |
- E_Generic_Procedure |
- E_Loop |
- E_Operator |
- E_Package |
- E_Package_Body |
- E_Procedure |
- E_Record_Type |
- E_Record_Subtype |
- E_Return_Statement |
- E_Subprogram_Body |
- E_Subprogram_Type =>
+ when E_Block |
+ Class_Wide_Kind |
+ Concurrent_Kind |
+ Private_Kind |
+ E_Entry |
+ E_Entry_Family |
+ E_Function |
+ E_Generic_Function |
+ E_Generic_Package |
+ E_Generic_Procedure |
+ E_Loop |
+ E_Operator |
+ E_Package |
+ E_Package_Body |
+ E_Procedure |
+ E_Record_Type |
+ E_Record_Subtype |
+ E_Return_Statement |
+ E_Subprogram_Body |
+ E_Subprogram_Type =>
Write_Str ("First_Entity");
- when Array_Kind =>
+ when Array_Kind =>
Write_Str ("First_Index");
- when E_Protected_Body =>
+ when E_Protected_Body =>
Write_Str ("Object_Ref");
- when Enumeration_Kind =>
+ when Enumeration_Kind =>
Write_Str ("First_Literal");
- when Access_Kind =>
+ when Access_Kind =>
Write_Str ("Master_Id");
- when Modular_Integer_Kind =>
+ when Modular_Integer_Kind =>
Write_Str ("Modulus");
- when Formal_Kind |
- E_Constant |
- E_Generic_In_Out_Parameter |
- E_Variable =>
+ when Formal_Kind |
+ E_Constant |
+ E_Generic_In_Out_Parameter |
+ E_Variable =>
Write_Str ("Actual_Subtype");
- when E_Incomplete_Type =>
+ when E_Incomplete_Type =>
Write_Str ("Non_Limited_View");
- when E_Incomplete_Subtype =>
+ when E_Incomplete_Subtype =>
if From_With_Type (Id) then
Write_Str ("Non_Limited_View");
end if;
- when others =>
+ when others =>
Write_Str ("Field17??");
end case;
end Write_Field17_Name;
procedure Write_Field18_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Enumeration_Literal |
- E_Function |
- E_Operator |
- E_Procedure =>
+ when E_Enumeration_Literal |
+ E_Function |
+ E_Operator |
+ E_Procedure =>
Write_Str ("Alias");
- when E_Record_Type =>
+ when E_Record_Type =>
Write_Str ("Corresponding_Concurrent_Type");
- when E_Entry_Index_Parameter =>
+ when E_Entry_Index_Parameter =>
Write_Str ("Entry_Index_Constant");
- when E_Class_Wide_Subtype |
- E_Access_Protected_Subprogram_Type |
- E_Access_Subprogram_Type |
- E_Exception_Type =>
+ when E_Class_Wide_Subtype |
+ E_Access_Protected_Subprogram_Type |
+ E_Anonymous_Access_Protected_Subprogram_Type |
+ E_Access_Subprogram_Type |
+ E_Exception_Type =>
Write_Str ("Equivalent_Type");
- when Fixed_Point_Kind =>
+ when Fixed_Point_Kind =>
Write_Str ("Delta_Value");
- when E_Constant |
- E_Variable =>
+ when E_Constant |
+ E_Variable =>
Write_Str ("Renamed_Object");
- when E_Exception |
- E_Package |
- E_Generic_Function |
- E_Generic_Procedure |
- E_Generic_Package =>
+ when E_Exception |
+ E_Package |
+ E_Generic_Function |
+ E_Generic_Procedure |
+ E_Generic_Package =>
Write_Str ("Renamed_Entity");
- when Incomplete_Or_Private_Kind =>
+ when Incomplete_Or_Private_Kind =>
Write_Str ("Private_Dependents");
- when Concurrent_Kind =>
+ when Concurrent_Kind =>
Write_Str ("Corresponding_Record_Type");
- when E_Label |
- E_Loop |
- E_Block =>
+ when E_Label |
+ E_Loop |
+ E_Block =>
Write_Str ("Enclosing_Scope");
- when others =>
+ when others =>
Write_Str ("Field18??");
end case;
end Write_Field18_Name;
procedure Write_Field19_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Array_Type |
- E_Array_Subtype =>
+ when E_Array_Type |
+ E_Array_Subtype =>
Write_Str ("Related_Array_Object");
- when E_Block |
- Concurrent_Kind |
- E_Function |
- E_Procedure |
- Entry_Kind =>
+ when E_Block |
+ Concurrent_Kind |
+ E_Function |
+ E_Procedure |
+ E_Return_Statement |
+ Entry_Kind =>
Write_Str ("Finalization_Chain_Entity");
- when E_Constant | E_Variable =>
+ when E_Constant | E_Variable =>
Write_Str ("Size_Check_Code");
- when E_Discriminant =>
+ when E_Discriminant =>
Write_Str ("Corresponding_Discriminant");
- when E_Package |
- E_Generic_Package =>
+ when E_Package |
+ E_Generic_Package =>
Write_Str ("Body_Entity");
- when E_Package_Body |
- Formal_Kind =>
+ when E_Package_Body |
+ Formal_Kind =>
Write_Str ("Spec_Entity");
- when Private_Kind =>
+ when Private_Kind =>
Write_Str ("Underlying_Full_View");
- when E_Record_Type =>
+ when E_Record_Type =>
Write_Str ("Parent_Subtype");
- when others =>
+ when others =>
Write_Str ("Field19??");
end case;
end Write_Field19_Name;
procedure Write_Field20_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Array_Kind =>
+ when Array_Kind =>
Write_Str ("Component_Type");
- when E_In_Parameter |
- E_Generic_In_Parameter =>
+ when E_In_Parameter |
+ E_Generic_In_Parameter =>
Write_Str ("Default_Value");
- when Access_Kind =>
+ when Access_Kind =>
Write_Str ("Directly_Designated_Type");
- when E_Component =>
+ when E_Component =>
Write_Str ("Discriminant_Checking_Func");
- when E_Discriminant =>
+ when E_Discriminant =>
Write_Str ("Discriminant_Default_Value");
- when E_Block |
- Class_Wide_Kind |
- Concurrent_Kind |
- Private_Kind |
- E_Entry |
- E_Entry_Family |
- E_Function |
- E_Generic_Function |
- E_Generic_Package |
- E_Generic_Procedure |
- E_Loop |
- E_Operator |
- E_Package |
- E_Package_Body |
- E_Procedure |
- E_Record_Type |
- E_Record_Subtype |
- E_Return_Statement |
- E_Subprogram_Body |
- E_Subprogram_Type =>
+ when E_Block |
+ Class_Wide_Kind |
+ Concurrent_Kind |
+ Private_Kind |
+ E_Entry |
+ E_Entry_Family |
+ E_Function |
+ E_Generic_Function |
+ E_Generic_Package |
+ E_Generic_Procedure |
+ E_Loop |
+ E_Operator |
+ E_Package |
+ E_Package_Body |
+ E_Procedure |
+ E_Record_Type |
+ E_Record_Subtype |
+ E_Return_Statement |
+ E_Subprogram_Body |
+ E_Subprogram_Type =>
Write_Str ("Last_Entity");
- when Scalar_Kind =>
+ when Scalar_Kind =>
Write_Str ("Scalar_Range");
- when E_Exception =>
+ when E_Exception =>
Write_Str ("Register_Exception_Call");
- when E_Variable =>
+ when E_Variable =>
Write_Str ("Last_Assignment");
- when others =>
+ when others =>
Write_Str ("Field20??");
end case;
end Write_Field20_Name;
procedure Write_Field21_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Constant |
- E_Exception |
- E_Function |
- E_Generic_Function |
- E_Procedure |
- E_Generic_Procedure |
- E_Variable =>
+ when E_Constant |
+ E_Exception |
+ E_Function |
+ E_Generic_Function |
+ E_Procedure |
+ E_Generic_Procedure |
+ E_Variable =>
Write_Str ("Interface_Name");
- when Concurrent_Kind |
- Incomplete_Or_Private_Kind |
- Class_Wide_Kind |
- E_Record_Type |
- E_Record_Subtype =>
+ when Concurrent_Kind |
+ Incomplete_Or_Private_Kind |
+ Class_Wide_Kind |
+ E_Record_Type |
+ E_Record_Subtype =>
Write_Str ("Discriminant_Constraint");
- when Entry_Kind =>
+ when Entry_Kind =>
Write_Str ("Accept_Address");
- when Fixed_Point_Kind =>
+ when Fixed_Point_Kind =>
Write_Str ("Small_Value");
- when E_In_Parameter =>
+ when E_In_Parameter =>
Write_Str ("Default_Expr_Function");
- when Array_Kind |
- Modular_Integer_Kind =>
+ when Array_Kind |
+ Modular_Integer_Kind =>
Write_Str ("Original_Array_Type");
- when E_Access_Subprogram_Type |
- E_Access_Protected_Subprogram_Type =>
+ when E_Access_Subprogram_Type |
+ E_Access_Protected_Subprogram_Type =>
Write_Str ("Original_Access_Type");
- when others =>
+ when others =>
Write_Str ("Field21??");
end case;
end Write_Field21_Name;
procedure Write_Field22_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Access_Kind =>
+ when Access_Kind =>
Write_Str ("Associated_Storage_Pool");
- when Array_Kind =>
+ when Array_Kind =>
Write_Str ("Component_Size");
- when E_Component |
- E_Discriminant =>
+ when E_Component |
+ E_Discriminant =>
Write_Str ("Original_Record_Component");
- when E_Enumeration_Literal =>
+ when E_Enumeration_Literal =>
Write_Str ("Enumeration_Rep_Expr");
- when E_Exception =>
+ when E_Exception =>
Write_Str ("Exception_Code");
- when Formal_Kind =>
+ when Formal_Kind =>
Write_Str ("Protected_Formal");
- when E_Record_Type =>
+ when E_Record_Type =>
Write_Str ("Corresponding_Remote_Type");
- when E_Block |
- E_Entry |
- E_Entry_Family |
- E_Function |
- E_Loop |
- E_Package |
- E_Package_Body |
- E_Generic_Package |
- E_Generic_Function |
- E_Generic_Procedure |
- E_Procedure |
- E_Protected_Type |
- E_Return_Statement |
- E_Subprogram_Body |
- E_Task_Type =>
+ when E_Block |
+ E_Entry |
+ E_Entry_Family |
+ E_Function |
+ E_Loop |
+ E_Package |
+ E_Package_Body |
+ E_Generic_Package |
+ E_Generic_Function |
+ E_Generic_Procedure |
+ E_Procedure |
+ E_Protected_Type |
+ E_Return_Statement |
+ E_Subprogram_Body |
+ E_Task_Type =>
Write_Str ("Scope_Depth_Value");
- when E_Record_Type_With_Private |
- E_Record_Subtype_With_Private |
- E_Private_Type |
- E_Private_Subtype |
- E_Limited_Private_Type |
- E_Limited_Private_Subtype =>
+ when E_Record_Type_With_Private |
+ E_Record_Subtype_With_Private |
+ E_Private_Type |
+ E_Private_Subtype |
+ E_Limited_Private_Type |
+ E_Limited_Private_Subtype =>
Write_Str ("Private_View");
- when E_Variable =>
+ when E_Variable =>
Write_Str ("Shared_Var_Assign_Proc");
- when others =>
+ when others =>
Write_Str ("Field22??");
end case;
end Write_Field22_Name;
procedure Write_Field23_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when Access_Kind =>
+ when Access_Kind =>
Write_Str ("Associated_Final_Chain");
- when Array_Kind =>
+ when Array_Kind =>
Write_Str ("Packed_Array_Type");
- when E_Block =>
+ when E_Block =>
Write_Str ("Entry_Cancel_Parameter");
- when E_Component =>
+ when E_Component =>
Write_Str ("Protected_Operation");
- when E_Discriminant =>
+ when E_Discriminant =>
Write_Str ("CR_Discriminant");
- when E_Enumeration_Type =>
+ when E_Enumeration_Type =>
Write_Str ("Enum_Pos_To_Rep");
- when Formal_Kind |
- E_Variable =>
+ when Formal_Kind |
+ E_Variable =>
Write_Str ("Extra_Constrained");
- when E_Generic_Function |
- E_Generic_Package |
- E_Generic_Procedure =>
+ when E_Generic_Function |
+ E_Generic_Package |
+ E_Generic_Procedure =>
Write_Str ("Inner_Instances");
- when Concurrent_Kind |
- Incomplete_Or_Private_Kind |
- Class_Wide_Kind |
- E_Record_Type |
- E_Record_Subtype =>
+ when Concurrent_Kind |
+ Incomplete_Or_Private_Kind |
+ Class_Wide_Kind |
+ E_Record_Type |
+ E_Record_Subtype =>
Write_Str ("Stored_Constraint");
- when E_Function |
- E_Procedure =>
+ when E_Function |
+ E_Procedure =>
Write_Str ("Generic_Renamings");
- when E_Package =>
+ when E_Package =>
if Is_Generic_Instance (Id) then
Write_Str ("Generic_Renamings");
else
-- What about Privals_Chain for protected operations ???
- when Entry_Kind =>
+ when Entry_Kind =>
Write_Str ("Privals_Chain");
- when others =>
+ when others =>
Write_Str ("Field23??");
end case;
end Write_Field23_Name;
procedure Write_Field25_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Component =>
+ when E_Component =>
Write_Str ("DT_Offset_To_Top_Func");
- when E_Procedure |
- E_Function =>
+ when E_Procedure |
+ E_Function =>
Write_Str ("Abstract_Interface_Alias");
- when E_Package =>
+ when E_Package =>
Write_Str ("Current_Use_Clause");
- when E_Record_Type |
- E_Record_Subtype |
- E_Record_Type_With_Private |
- E_Record_Subtype_With_Private =>
+ when E_Record_Type |
+ E_Record_Subtype |
+ E_Record_Type_With_Private |
+ E_Record_Subtype_With_Private =>
Write_Str ("Abstract_Interfaces");
- when Task_Kind =>
+ when Task_Kind =>
Write_Str ("Task_Body_Procedure");
- when others =>
+ when others =>
Write_Str ("Field25??");
end case;
end Write_Field25_Name;
procedure Write_Field26_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Generic_Package |
- E_Package =>
+ when E_Generic_Package |
+ E_Package =>
Write_Str ("Package_Instantiation");
- when E_Procedure |
- E_Function =>
+ when E_Procedure |
+ E_Function =>
Write_Str ("Overridden_Operation");
- when others =>
+ when others =>
Write_Str ("Field26??");
end case;
end Write_Field26_Name;
procedure Write_Field27_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Procedure =>
+ when E_Procedure =>
Write_Str ("Wrapped_Entity");
- when others =>
+ when others =>
Write_Str ("Field27??");
end case;
end Write_Field27_Name;
procedure Write_Field28_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Procedure | E_Function | E_Entry =>
+ when E_Procedure | E_Function | E_Entry =>
Write_Str ("Extra_Formals");
- when others =>
+ when others =>
Write_Str ("Field28??");
end case;
end Write_Field28_Name;
-- Iterator Procedures --
-------------------------
- procedure Proc_Next_Component (N : in out Node_Id) is
+ procedure Proc_Next_Component (N : in out Node_Id) is
begin
N := Next_Component (N);
end Proc_Next_Component;
- procedure Proc_Next_Discriminant (N : in out Node_Id) is
+ procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id) is
+ begin
+ N := Next_Component (N);
+ end Proc_Next_Component_Or_Discriminant;
+
+ procedure Proc_Next_Discriminant (N : in out Node_Id) is
begin
N := Next_Discriminant (N);
end Proc_Next_Discriminant;
- procedure Proc_Next_Formal (N : in out Node_Id) is
+ procedure Proc_Next_Formal (N : in out Node_Id) is
begin
N := Next_Formal (N);
end Proc_Next_Formal;
- procedure Proc_Next_Formal_With_Extras (N : in out Node_Id) is
+ procedure Proc_Next_Formal_With_Extras (N : in out Node_Id) is
begin
N := Next_Formal_With_Extras (N);
end Proc_Next_Formal_With_Extras;
- procedure Proc_Next_Index (N : in out Node_Id) is
+ procedure Proc_Next_Index (N : in out Node_Id) is
begin
N := Next_Index (N);
end Proc_Next_Index;
- procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id) is
+ procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id) is
begin
N := Next_Inlined_Subprogram (N);
end Proc_Next_Inlined_Subprogram;
- procedure Proc_Next_Literal (N : in out Node_Id) is
+ procedure Proc_Next_Literal (N : in out Node_Id) is
begin
N := Next_Literal (N);
end Proc_Next_Literal;
- procedure Proc_Next_Stored_Discriminant (N : in out Node_Id) is
+ procedure Proc_Next_Stored_Discriminant (N : in out Node_Id) is
begin
N := Next_Stored_Discriminant (N);
end Proc_Next_Stored_Discriminant;
-- entity designed by this field instead of being computed.
-- Finalization_Chain_Entity (Node19)
--- Present in scopes which can have finalizable entities (blocks,
--- functions, procedures, tasks, entries). When this field is empty it
--- means that there are no finalization actions to perform on exit of the
--- scope. When this field contains 'Error', it means that no
--- finalization actions should happen at this level and the
--- finalization chain of a parent scope shall be used (??? this is
--- an improper use of 'Error' and should be changed). otherwise it
+-- Present in scopes that can have finalizable entities (blocks,
+-- functions, procedures, tasks, entries, return statements). When this
+-- field is empty it means that there are no finalization actions to
+-- perform on exit of the scope. When this field contains 'Error', it
+-- means that no finalization actions should happen at this level and
+-- the finalization chain of a parent scope shall be used (??? this is
+-- an improper use of 'Error' and should be changed). Otherwise it
-- contains an entity of type Finalizable_Ptr that is the head of the
-- list of objects to finalize on exit. See "Finalization Management"
-- section in exp_ch7.adb for more details.
-- derivation.
-- First_Component (synthesized)
--- Applies to record types. Returns the first component by following
--- the chain of declared entities for the record until a component
--- is found (one with an Ekind of E_Component). The discriminants are
--- skipped. If the record is null, then Empty is returned.
+-- Applies to record types. Returns the first component by following the
+-- chain of declared entities for the record until a component is found
+-- (one with an Ekind of E_Component). The discriminants are skipped. If
+-- the record is null, then Empty is returned.
+
+-- First_Component_Or_Discriminant (synthesized)
+-- Similar to First_Component, but discriminants are not skipped, so will
+-- find the first discriminant if discriminants are present.
-- First_Discriminant (synthesized)
--- Applies to types with discriminants. The discriminants are the
--- first entities declared in the type, so normally this is equivalent
--- to First_Entity. The exception arises for tagged types, where the
--- tag itself is prepended to the front of the entity chain, so the
+-- Applies to types with discriminants. The discriminants are the first
+-- entities declared in the type, so normally this is equivalent to
+-- First_Entity. The exception arises for tagged types, where the tag
+-- itself is prepended to the front of the entity chain, so the
-- First_Discriminant function steps past the tag if it is present.
-- First_Entity (Node17)
-- True if Targparm.Functions_Return_By_DSP_On_Target is True and
-- the function returns a value of a type whose size is not known
-- at compile time.
+--
+-- Note: this flag is obsolete, it is always False ???
-- Generic_Homonym (Node11)
-- Present in generic packages. The generic homonym is the entity of
-- Present in all entities. Set if a valid pragma Unreferenced applies
-- to the pragma, indicating that no warning should be given if the
-- entity has no references, but a warning should be given if it is
--- in fact referenced.
+-- in fact referenced. For private types, this flag is set in both the
+-- private entity and full entity if the pragma applies to either.
+
+-- Has_Pragma_Unreferenced_Objects (Flag212)
+-- Present in type and subtype entities. Set if a valid pragma
+-- Unreferenced_Objects applies to the type, indicating that no warning
+-- should be given for objects of such a type for being unreferenced
+-- (but unlike the case with pragma Unreferenced, it is ok to reference
+-- such an object and no warning is generated.
-- Known_To_Have_Preelab_Init (Flag207)
-- Present in all type and subtype entities. If set, then the type is
-- the flag Has_Fully_Qualified_Name, which is set if the name does
-- indeed include the fully qualified name.
+-- Has_RACW (Flag214)
+-- Present in package spec entities. Set if the spec contains the
+-- declaration of a remote access-to-classwide type.
+
-- Has_Record_Rep_Clause (Flag65) [implementation base type only]
-- Present in record types. Set if a record representation clause has
-- been given for this record type. Used to prevent more than one such
-- Has_Task (Flag30) [base type only]
-- Present in all type entities. Set on task types themselves, and also
-- (recursively) on any composite type which has a component for which
--- Has_Task is set. The meaning is that an allocator of such an object
--- must create the required tasks. Note that the flag is not set on
--- access types, even if they designate an object that Has_Task.
+-- Has_Task is set. The meaning is that an allocator or declaration of
+-- such an object must create the required tasks. Note: the flag is not
+-- set on access types, even if they designate an object that Has_Task.
-- Has_Unchecked_Union (Flag123) [base type only]
-- Present in all type entities. Set on unchecked unions themselves
-- part. The flag on a type is also used to determine the visibility of
-- the primitive operators of the type.
--- Is_Abstract (Flag19)
--- Present in all types, and also for functions and procedures. Set
--- for abstract types and abstract subprograms.
+-- Is_Abstract_Subprogram (Flag19)
+-- Present in all subprograms and entries. Set for abstract subprograms.
+-- Always False for enumeration literals and entries. See also
+-- Requires_Overriding.
+
+-- Is_Abstract_Type (Flag146)
+-- Present in all types. Set for abstract types.
-- Is_Local_Anonymous_Access (Flag194)
-- Present in access types. Set for an anonymous access type to indicate
-- Present in access types and subtypes. Indicates that the keyword
-- constant was present in the access type definition.
+-- Is_Access_Protected_Subprogram_Type (synthesized)
+-- Applies to all types, true for named and anonymous access to
+-- protected subprograms.
+
-- Is_Access_Type (synthesized)
-- Applies to all entities, true for access types and subtypes
-- of dispatching operations.
-- Is_CPP_Class (Flag74)
--- Present in all type entities, set only for tagged and untagged
--- record types to which the pragma CPP_Class has been applied.
+-- Present in all type entities, set only for tagged types to which a
+-- valid pragma Import (CPP, ...) or pragma CPP_Class has been applied.
-- Is_Decimal_Fixed_Point_Type (synthesized)
-- Applies to all type entities, true for decimal fixed point
-- Master_Id (Node17)
-- Present in access types and subtypes. Empty unless Has_Task is
-- set for the designated type, in which case it points to the entity
--- for the Master_Id for the access type master.
+-- for the Master_Id for the access type master. Also set for access-to-
+-- limited-class-wide types whose root may be extended with task
+-- components, and for access-to-limited-interfaces because they can be
+-- used to reference tasks implementing such interface.
-- Materialize_Entity (Flag168)
-- Present in all entities. Set only for constant or renamed entities
-- the renaming possibility.
-- Next_Component (synthesized)
--- Applies to record components. Returns the next component by
--- following the chain of declared entities until one is found which
--- corresponds to a component (Ekind is E_Component). Any internal types
--- generated from the subtype indications of the record components are
--- skipped. Returns Empty if no more components.
+-- Applies to record components. Returns the next component by following
+-- the chain of declared entities until one is found which corresponds to
+-- a component (Ekind is E_Component). Any internal types generated from
+-- the subtype indications of the record components are skipped. Returns
+-- Empty if no more components.
+
+-- Next_Component_Or_Discriminant (synthesized)
+-- Similar to Next_Component, but includes components and discriminants
+-- so the input can have either E_Component or E_Discriminant, and the
+-- same is true for the result. Returns Empty if no more components or
+-- discriminants in the record.
-- Next_Discriminant (synthesized)
-- Applies to discriminants returned by First/Next_Discriminant.
-- details. The maps for package instances are also used when the
-- instance is the actual corresponding to a formal package.
+-- Requires_Overriding (Flag213)
+-- Present in all subprograms and entries. Set for subprograms that
+-- require overriding as defined by RM-2005-3.9.3(6/2). Note that this
+-- is True only for implicitly declare subprograms; it is not set on the
+-- parent type's subprogram. See also Is_Abstract_Subprogram.
+
-- Return_Present (Flag54)
-- Present in function and generic function entities. Set if the
-- function contains a return statement (used for error checking).
-- Reverse_Bit_Order (Flag164) [base type only]
-- Present in all record type entities. Set if a valid pragma an
--- attribute represention clause for Bit_Order has reversed the order
--- of bits from the default value. When this flag is set, a component
--- clause must specify a set of bits entirely contained in a single
--- storage unit.
+-- attribute represention clause for Bit_Order has reversed the order of
+-- bits from the default value. When this flag is set, a component clause
+-- must specify a set of bits entirely contained in a single storage unit
+-- (Ada 95) or a single machine scalar (see Ada 2005 AI-133), or must
+-- occupy in integral number of storage units.
-- RM_Size (Uint13)
-- Present in all type and subtype entities. Contains the value of
-- Access Kinds --
------------------
- -- The following three entity kinds are introduced by the corresponding
+ -- The following five entity kinds are introduced by the corresponding
-- type definitions:
-- E_Access_Type,
-- An access to subprogram type, created by an access to subprogram
-- declaration.
+ E_Anonymous_Access_Subprogram_Type,
+ -- An anonymous access to subprogram type, created by an access to
+ -- subprogram declaration.
+
E_Access_Protected_Subprogram_Type,
-- An access to a protected subprogram, created by the corresponding
-- declaration. Values of such a type denote both a protected object
-- and a protected operation within, and have different compile-time
-- and run-time properties than other access to subprograms.
- E_Anonymous_Access_Subprogram_Type,
- -- An anonymous access to subprogram type, created by an access to
- -- subprogram declaration.
-
E_Anonymous_Access_Protected_Subprogram_Type,
-- An anonymous access to protected subprogram type, created by an
-- access to subprogram declaration.
-- E_Allocator_Type
-- E_General_Access_Type
-- E_Access_Subprogram_Type
- -- E_Access_Protected_Subprogram_Type
-- E_Anonymous_Access_Subprogram_Type
+ -- E_Access_Protected_Subprogram_Type
-- E_Anonymous_Access_Protected_Subprogram_Type
E_Anonymous_Access_Type;
+ subtype Access_Protected_Kind is Entity_Kind range
+ E_Access_Protected_Subprogram_Type ..
+ E_Anonymous_Access_Protected_Subprogram_Type;
+
subtype Array_Kind is Entity_Kind range
E_Array_Type ..
-- E_Array_Subtype
-- The following attributes apply to all entities
- -- Ekind (Ekind)
-
- -- Chars (Name1)
- -- Next_Entity (Node2)
- -- Scope (Node3)
- -- Homonym (Node4)
- -- Etype (Node5)
- -- First_Rep_Item (Node6)
- -- Freeze_Node (Node7)
- -- Obsolescent_Warning (Node24)
-
- -- Address_Taken (Flag104)
- -- Can_Never_Be_Null (Flag38)
- -- Checks_May_Be_Suppressed (Flag31)
- -- Debug_Info_Off (Flag166)
- -- Has_Anon_Block_Suffix (Flag201)
- -- Has_Controlled_Component (Flag43) (base type only)
- -- Has_Convention_Pragma (Flag119)
- -- Has_Delayed_Freeze (Flag18)
- -- Has_Fully_Qualified_Name (Flag173)
- -- Has_Gigi_Rep_Item (Flag82)
- -- Has_Homonym (Flag56)
- -- Has_Persistent_BSS (Flag188)
- -- Has_Pragma_Elaborate_Body (Flag150)
- -- Has_Pragma_Inline (Flag157)
- -- Has_Pragma_Pure (Flag203)
- -- Has_Pragma_Pure_Function (Flag179)
- -- Has_Pragma_Unreferenced (Flag180)
- -- Has_Private_Declaration (Flag155)
- -- Has_Qualified_Name (Flag161)
- -- Has_Unknown_Discriminants (Flag72)
- -- Has_Xref_Entry (Flag182)
- -- Is_Ada_2005_Only (Flag185)
- -- Is_Bit_Packed_Array (Flag122) (base type only)
- -- Is_Child_Unit (Flag73)
- -- Is_Compilation_Unit (Flag149)
- -- Is_Completely_Hidden (Flag103)
- -- Is_Discrim_SO_Function (Flag176)
- -- Is_Dispatching_Operation (Flag6)
- -- Is_Exported (Flag99)
- -- Is_First_Subtype (Flag70)
- -- Is_Formal_Subprogram (Flag111)
- -- Is_Generic_Instance (Flag130)
- -- Is_Hidden (Flag57)
- -- Is_Hidden_Open_Scope (Flag171)
- -- Is_Immediately_Visible (Flag7)
- -- Is_Imported (Flag24)
- -- Is_Inlined (Flag11)
- -- Is_Internal (Flag17)
- -- Is_Itype (Flag91)
- -- Is_Known_Non_Null (Flag37)
- -- Is_Known_Null (Flag204)
- -- Is_Known_Valid (Flag170)
- -- Is_Limited_Composite (Flag106)
- -- Is_Limited_Record (Flag25)
- -- Is_Obsolescent (Flag153)
- -- Is_Package_Body_Entity (Flag160)
- -- Is_Packed_Array_Type (Flag138)
- -- Is_Potentially_Use_Visible (Flag9)
- -- Is_Preelaborated (Flag59)
- -- Is_Primitive_Wrapper (Flag195)
- -- Is_Public (Flag10)
- -- Is_Pure (Flag44)
- -- Is_Remote_Call_Interface (Flag62)
- -- Is_Remote_Types (Flag61)
- -- Is_Shared_Passive (Flag60)
- -- Is_Statically_Allocated (Flag28)
- -- Is_Unchecked_Union (Flag117)
- -- Is_Visible_Formal (Flag206)
- -- Is_VMS_Exception (Flag133)
- -- Kill_Elaboration_Checks (Flag32)
- -- Kill_Range_Checks (Flag33)
- -- Kill_Tag_Checks (Flag34)
- -- Low_Bound_Known (Flag205)
- -- Materialize_Entity (Flag168)
- -- Needs_Debug_Info (Flag147)
- -- No_Return (Flag113)
- -- Referenced (Flag156)
- -- Referenced_As_LHS (Flag36)
- -- Suppress_Elaboration_Warnings (Flag148)
- -- Suppress_Style_Checks (Flag165)
- -- Was_Hidden (Flag196)
-
- -- Declaration_Node (synth)
- -- Enclosing_Dynamic_Scope (synth)
- -- Has_Foreign_Convention (synth)
- -- Is_Derived_Type (synth)
- -- Is_Dynamic_Scope (synth)
- -- Is_Limited_Type (synth)
- -- Underlying_Type (synth)
- -- all classification attributes (synth)
+ -- Ekind (Ekind)
+
+ -- Chars (Name1)
+ -- Next_Entity (Node2)
+ -- Scope (Node3)
+ -- Homonym (Node4)
+ -- Etype (Node5)
+ -- First_Rep_Item (Node6)
+ -- Freeze_Node (Node7)
+ -- Obsolescent_Warning (Node24)
+
+ -- Address_Taken (Flag104)
+ -- Can_Never_Be_Null (Flag38)
+ -- Checks_May_Be_Suppressed (Flag31)
+ -- Debug_Info_Off (Flag166)
+ -- Has_Anon_Block_Suffix (Flag201)
+ -- Has_Controlled_Component (Flag43) (base type only)
+ -- Has_Convention_Pragma (Flag119)
+ -- Has_Delayed_Freeze (Flag18)
+ -- Has_Fully_Qualified_Name (Flag173)
+ -- Has_Gigi_Rep_Item (Flag82)
+ -- Has_Homonym (Flag56)
+ -- Has_Persistent_BSS (Flag188)
+ -- Has_Pragma_Elaborate_Body (Flag150)
+ -- Has_Pragma_Inline (Flag157)
+ -- Has_Pragma_Pure (Flag203)
+ -- Has_Pragma_Pure_Function (Flag179)
+ -- Has_Pragma_Unreferenced (Flag180)
+ -- Has_Private_Declaration (Flag155)
+ -- Has_Qualified_Name (Flag161)
+ -- Has_Unknown_Discriminants (Flag72)
+ -- Has_Xref_Entry (Flag182)
+ -- Is_Ada_2005_Only (Flag185)
+ -- Is_Bit_Packed_Array (Flag122) (base type only)
+ -- Is_Child_Unit (Flag73)
+ -- Is_Compilation_Unit (Flag149)
+ -- Is_Completely_Hidden (Flag103)
+ -- Is_Discrim_SO_Function (Flag176)
+ -- Is_Dispatching_Operation (Flag6)
+ -- Is_Exported (Flag99)
+ -- Is_First_Subtype (Flag70)
+ -- Is_Formal_Subprogram (Flag111)
+ -- Is_Generic_Instance (Flag130)
+ -- Is_Hidden (Flag57)
+ -- Is_Hidden_Open_Scope (Flag171)
+ -- Is_Immediately_Visible (Flag7)
+ -- Is_Imported (Flag24)
+ -- Is_Inlined (Flag11)
+ -- Is_Internal (Flag17)
+ -- Is_Itype (Flag91)
+ -- Is_Known_Non_Null (Flag37)
+ -- Is_Known_Null (Flag204)
+ -- Is_Known_Valid (Flag170)
+ -- Is_Limited_Composite (Flag106)
+ -- Is_Limited_Record (Flag25)
+ -- Is_Obsolescent (Flag153)
+ -- Is_Package_Body_Entity (Flag160)
+ -- Is_Packed_Array_Type (Flag138)
+ -- Is_Potentially_Use_Visible (Flag9)
+ -- Is_Preelaborated (Flag59)
+ -- Is_Primitive_Wrapper (Flag195)
+ -- Is_Public (Flag10)
+ -- Is_Pure (Flag44)
+ -- Is_Remote_Call_Interface (Flag62)
+ -- Is_Remote_Types (Flag61)
+ -- Is_Shared_Passive (Flag60)
+ -- Is_Statically_Allocated (Flag28)
+ -- Is_Unchecked_Union (Flag117)
+ -- Is_Visible_Formal (Flag206)
+ -- Is_VMS_Exception (Flag133)
+ -- Kill_Elaboration_Checks (Flag32)
+ -- Kill_Range_Checks (Flag33)
+ -- Kill_Tag_Checks (Flag34)
+ -- Low_Bound_Known (Flag205)
+ -- Materialize_Entity (Flag168)
+ -- Needs_Debug_Info (Flag147)
+ -- No_Return (Flag113)
+ -- Referenced (Flag156)
+ -- Referenced_As_LHS (Flag36)
+ -- Suppress_Elaboration_Warnings (Flag148)
+ -- Suppress_Style_Checks (Flag165)
+ -- Was_Hidden (Flag196)
+
+ -- Declaration_Node (synth)
+ -- Enclosing_Dynamic_Scope (synth)
+ -- Has_Foreign_Convention (synth)
+ -- Is_Derived_Type (synth)
+ -- Is_Dynamic_Scope (synth)
+ -- Is_Limited_Type (synth)
+ -- Underlying_Type (synth)
+ -- all classification attributes (synth)
-- The following list of access functions applies to all entities for
-- types and subtypes. References to this list appear subsequently as
-- as "(plus type attributes)" for each appropriate Entity_Kind.
- -- Associated_Node_For_Itype (Node8)
- -- Class_Wide_Type (Node9)
- -- Referenced_Object (Node10)
- -- Full_View (Node11)
- -- Esize (Uint12)
- -- RM_Size (Uint13)
- -- Alignment (Uint14)
-
- -- Depends_On_Private (Flag14)
- -- Discard_Names (Flag88)
- -- Finalize_Storage_Only (Flag158) (base type only)
- -- From_With_Type (Flag159)
- -- Has_Aliased_Components (Flag135) (base type only)
- -- Has_Alignment_Clause (Flag46)
- -- Has_Atomic_Components (Flag86) (base type only)
- -- Has_Completion_In_Body (Flag71)
- -- Has_Complex_Representation (Flag140) (base type only)
- -- Has_Constrained_Partial_View (Flag187)
- -- Has_Discriminants (Flag5)
- -- Has_Non_Standard_Rep (Flag75) (base type only)
- -- Has_Object_Size_Clause (Flag172)
- -- Has_Primitive_Operations (Flag120) (base type only)
- -- Has_Size_Clause (Flag29)
- -- Has_Specified_Layout (Flag100) (base type only)
- -- Has_Specified_Stream_Input (Flag190)
- -- Has_Specified_Stream_Output (Flag191)
- -- Has_Specified_Stream_Read (Flag192)
- -- Has_Specified_Stream_Write (Flag193)
- -- Has_Task (Flag30) (base type only)
- -- Has_Unchecked_Union (Flag123) (base type only)
- -- Has_Volatile_Components (Flag87) (base type only)
- -- In_Use (Flag8)
- -- Is_Abstract (Flag19)
- -- Is_Asynchronous (Flag81)
- -- Is_Atomic (Flag85)
- -- Is_Constr_Subt_For_U_Nominal (Flag80)
- -- Is_Constr_Subt_For_UN_Aliased (Flag141)
- -- Is_Controlled (Flag42) (base type only)
- -- Is_Eliminated (Flag124)
- -- Is_Frozen (Flag4)
- -- Is_Generic_Actual_Type (Flag94)
- -- Is_Generic_Type (Flag13)
- -- Is_Limited_Interface (Flag197)
- -- Is_Protected_Interface (Flag198)
- -- Is_Synchronized_Interface (Flag199)
- -- Is_Task_Interface (Flag200)
- -- Is_Non_Static_Subtype (Flag109)
- -- Is_Packed (Flag51) (base type only)
- -- Is_Private_Composite (Flag107)
- -- Is_Renaming_Of_Object (Flag112)
- -- Is_Tagged_Type (Flag55)
- -- Is_Unsigned_Type (Flag144)
- -- Is_Volatile (Flag16)
- -- Itype_Printed (Flag202) (itypes only)
- -- Known_To_Have_Preelab_Init (Flag207)
- -- Must_Be_On_Byte_Boundary (Flag183)
- -- Must_Have_Preelab_Init (Flag208)
- -- Size_Depends_On_Discriminant (Flag177)
- -- Size_Known_At_Compile_Time (Flag92)
- -- Strict_Alignment (Flag145) (base type only)
- -- Suppress_Init_Proc (Flag105) (base type only)
- -- Treat_As_Volatile (Flag41)
-
- -- Alignment_Clause (synth)
- -- Ancestor_Subtype (synth)
- -- Base_Type (synth)
- -- First_Subtype (synth)
- -- Has_Private_Ancestor (synth)
- -- Implementation_Base_Type (synth)
- -- Is_By_Copy_Type (synth)
- -- Is_By_Reference_Type (synth)
- -- Is_Inherently_Limited_Type (synth)
- -- Root_Type (synth)
- -- Size_Clause (synth)
+ -- Associated_Node_For_Itype (Node8)
+ -- Class_Wide_Type (Node9)
+ -- Referenced_Object (Node10)
+ -- Full_View (Node11)
+ -- Esize (Uint12)
+ -- RM_Size (Uint13)
+ -- Alignment (Uint14)
+
+ -- Depends_On_Private (Flag14)
+ -- Discard_Names (Flag88)
+ -- Finalize_Storage_Only (Flag158) (base type only)
+ -- From_With_Type (Flag159)
+ -- Has_Aliased_Components (Flag135) (base type only)
+ -- Has_Alignment_Clause (Flag46)
+ -- Has_Atomic_Components (Flag86) (base type only)
+ -- Has_Completion_In_Body (Flag71)
+ -- Has_Complex_Representation (Flag140) (base type only)
+ -- Has_Constrained_Partial_View (Flag187)
+ -- Has_Discriminants (Flag5)
+ -- Has_Non_Standard_Rep (Flag75) (base type only)
+ -- Has_Object_Size_Clause (Flag172)
+ -- Has_Pragma_Unreferenced_Objects (Flag212)
+ -- Has_Primitive_Operations (Flag120) (base type only)
+ -- Has_Size_Clause (Flag29)
+ -- Has_Specified_Layout (Flag100) (base type only)
+ -- Has_Specified_Stream_Input (Flag190)
+ -- Has_Specified_Stream_Output (Flag191)
+ -- Has_Specified_Stream_Read (Flag192)
+ -- Has_Specified_Stream_Write (Flag193)
+ -- Has_Task (Flag30) (base type only)
+ -- Has_Unchecked_Union (Flag123) (base type only)
+ -- Has_Volatile_Components (Flag87) (base type only)
+ -- In_Use (Flag8)
+ -- Is_Abstract_Type (Flag146)
+ -- Is_Asynchronous (Flag81)
+ -- Is_Atomic (Flag85)
+ -- Is_Constr_Subt_For_U_Nominal (Flag80)
+ -- Is_Constr_Subt_For_UN_Aliased (Flag141)
+ -- Is_Controlled (Flag42) (base type only)
+ -- Is_Eliminated (Flag124)
+ -- Is_Frozen (Flag4)
+ -- Is_Generic_Actual_Type (Flag94)
+ -- Is_Generic_Type (Flag13)
+ -- Is_Limited_Interface (Flag197)
+ -- Is_Protected_Interface (Flag198)
+ -- Is_Synchronized_Interface (Flag199)
+ -- Is_Task_Interface (Flag200)
+ -- Is_Non_Static_Subtype (Flag109)
+ -- Is_Packed (Flag51) (base type only)
+ -- Is_Private_Composite (Flag107)
+ -- Is_Renaming_Of_Object (Flag112)
+ -- Is_Tagged_Type (Flag55)
+ -- Is_Unsigned_Type (Flag144)
+ -- Is_Volatile (Flag16)
+ -- Itype_Printed (Flag202) (itypes only)
+ -- Known_To_Have_Preelab_Init (Flag207)
+ -- Must_Be_On_Byte_Boundary (Flag183)
+ -- Must_Have_Preelab_Init (Flag208)
+ -- Size_Depends_On_Discriminant (Flag177)
+ -- Size_Known_At_Compile_Time (Flag92)
+ -- Strict_Alignment (Flag145) (base type only)
+ -- Suppress_Init_Proc (Flag105) (base type only)
+ -- Treat_As_Volatile (Flag41)
+
+ -- Alignment_Clause (synth)
+ -- Ancestor_Subtype (synth)
+ -- Base_Type (synth)
+ -- First_Subtype (synth)
+ -- Has_Private_Ancestor (synth)
+ -- Implementation_Base_Type (synth)
+ -- Is_Access_Protected_Subprogram_Type (synth)
+ -- Is_By_Copy_Type (synth)
+ -- Is_By_Reference_Type (synth)
+ -- Is_Inherently_Limited_Type (synth)
+ -- Root_Type (synth)
+ -- Size_Clause (synth)
------------------------------------------
-- Applicable attributes by entity kind --
------------------------------------------
-- E_Access_Protected_Subprogram_Type
- -- Equivalent_Type (Node18)
- -- Directly_Designated_Type (Node20)
- -- Original_Access_Type (Node21)
- -- Needs_No_Actuals (Flag22)
- -- (plus type attributes)
+ -- Equivalent_Type (Node18)
+ -- Directly_Designated_Type (Node20)
+ -- Original_Access_Type (Node21)
+ -- Needs_No_Actuals (Flag22)
+ -- (plus type attributes)
-- E_Access_Subprogram_Type
- -- Equivalent_Type (Node18) (remote types only)
- -- Directly_Designated_Type (Node20)
- -- Original_Access_Type (Node21)
- -- Needs_No_Actuals (Flag22)
- -- (plus type attributes)
+ -- Equivalent_Type (Node18) (remote types only)
+ -- Directly_Designated_Type (Node20)
+ -- Original_Access_Type (Node21)
+ -- Needs_No_Actuals (Flag22)
+ -- (plus type attributes)
-- E_Access_Type
-- E_Access_Subtype
- -- Storage_Size_Variable (Node15) (base type only)
- -- Master_Id (Node17)
- -- Directly_Designated_Type (Node20)
- -- Associated_Storage_Pool (Node22) (base type only)
- -- Associated_Final_Chain (Node23)
- -- Has_Pragma_Controlled (Flag27) (base type only)
- -- Has_Storage_Size_Clause (Flag23) (base type only)
- -- Is_Local_Anonymous_Access (Flag194)
- -- Is_Access_Constant (Flag69)
- -- Is_Pure_Unit_Access_Type (Flag189)
- -- No_Pool_Assigned (Flag131) (base type only)
- -- No_Strict_Aliasing (Flag136) (base type only)
+ -- Storage_Size_Variable (Node15) (base type only)
+ -- Master_Id (Node17)
+ -- Directly_Designated_Type (Node20)
+ -- Associated_Storage_Pool (Node22) (base type only)
+ -- Associated_Final_Chain (Node23)
+ -- Has_Pragma_Controlled (Flag27) (base type only)
+ -- Has_Storage_Size_Clause (Flag23) (base type only)
+ -- Is_Local_Anonymous_Access (Flag194)
+ -- Is_Access_Constant (Flag69)
+ -- Is_Pure_Unit_Access_Type (Flag189)
+ -- No_Pool_Assigned (Flag131) (base type only)
+ -- No_Strict_Aliasing (Flag136) (base type only)
-- (plus type attributes)
-- E_Access_Attribute_Type
- -- Directly_Designated_Type (Node20)
+ -- Directly_Designated_Type (Node20)
-- (plus type attributes)
-- E_Allocator_Type
- -- Directly_Designated_Type (Node20)
+ -- Directly_Designated_Type (Node20)
-- (plus type attributes)
-- E_Anonymous_Access_Subprogram_Type
-- E_Anonymous_Access_Protected_Subprogram_Type
-- E_Anonymous_Access_Type
- -- Storage_Size_Variable (Node15) ??? is this needed ???
- -- Directly_Designated_Type (Node20)
+ -- Storage_Size_Variable (Node15) ??? is this needed ???
+ -- Directly_Designated_Type (Node20)
-- (plus type attributes)
-- E_Array_Type
-- E_Array_Subtype
- -- First_Index (Node17)
- -- Related_Array_Object (Node19)
- -- Component_Type (Node20) (base type only)
- -- Original_Array_Type (Node21)
- -- Component_Size (Uint22) (base type only)
- -- Packed_Array_Type (Node23)
- -- Component_Alignment (special) (base type only)
- -- Has_Component_Size_Clause (Flag68) (base type only)
- -- Has_Pragma_Pack (Flag121) (base type only)
- -- Is_Aliased (Flag15)
- -- Is_Constrained (Flag12)
- -- Next_Index (synth)
- -- Number_Dimensions (synth)
- -- (plus type attributes)
+ -- First_Index (Node17)
+ -- Related_Array_Object (Node19)
+ -- Component_Type (Node20) (base type only)
+ -- Original_Array_Type (Node21)
+ -- Component_Size (Uint22) (base type only)
+ -- Packed_Array_Type (Node23)
+ -- Component_Alignment (special) (base type only)
+ -- Has_Component_Size_Clause (Flag68) (base type only)
+ -- Has_Pragma_Pack (Flag121) (base type only)
+ -- Is_Aliased (Flag15)
+ -- Is_Constrained (Flag12)
+ -- Next_Index (synth)
+ -- Number_Dimensions (synth)
+ -- (plus type attributes)
-- E_Block
- -- Block_Node (Node11)
- -- First_Entity (Node17)
- -- Last_Entity (Node20)
- -- Delay_Cleanups (Flag114)
- -- Discard_Names (Flag88)
- -- Finalization_Chain_Entity (Node19)
- -- Scope_Depth_Value (Uint22)
- -- Entry_Cancel_Parameter (Node23)
- -- Has_Master_Entity (Flag21)
- -- Has_Nested_Block_With_Handler (Flag101)
- -- Sec_Stack_Needed_For_Return (Flag167)
- -- Uses_Sec_Stack (Flag95)
- -- Scope_Depth (synth)
+ -- Block_Node (Node11)
+ -- First_Entity (Node17)
+ -- Last_Entity (Node20)
+ -- Finalization_Chain_Entity (Node19)
+ -- Scope_Depth_Value (Uint22)
+ -- Entry_Cancel_Parameter (Node23)
+ -- Delay_Cleanups (Flag114)
+ -- Discard_Names (Flag88)
+ -- Has_Master_Entity (Flag21)
+ -- Has_Nested_Block_With_Handler (Flag101)
+ -- Sec_Stack_Needed_For_Return (Flag167)
+ -- Uses_Sec_Stack (Flag95)
+ -- Scope_Depth (synth)
-- E_Class_Wide_Type
-- E_Class_Wide_Subtype
- -- Cloned_Subtype (Node16) (subtype case only)
- -- First_Entity (Node17)
- -- Equivalent_Type (Node18) (always Empty in type case)
- -- Last_Entity (Node20)
- -- First_Component (synth)
- -- (plus type attributes)
+ -- Cloned_Subtype (Node16) (subtype case only)
+ -- First_Entity (Node17)
+ -- Equivalent_Type (Node18) (always Empty for type)
+ -- Last_Entity (Node20)
+ -- First_Component (synth)
+ -- First_Component_Or_Discriminant (synth)
+ -- First_Discriminant (synth)
+ -- (plus type attributes)
-- E_Component
- -- Normalized_First_Bit (Uint8)
- -- Current_Value (Node9) (always Empty)
- -- Normalized_Position_Max (Uint10)
- -- Component_Bit_Offset (Uint11)
- -- Esize (Uint12)
- -- Component_Clause (Node13)
- -- Normalized_Position (Uint14)
- -- DT_Entry_Count (Uint15)
- -- Entry_Formal (Node16)
- -- Prival (Node17)
- -- Renamed_Object (Node18) (always Empty)
- -- Discriminant_Checking_Func (Node20)
- -- Interface_Name (Node21) (JGNAT usage only)
- -- Original_Record_Component (Node22)
- -- Protected_Operation (Node23)
- -- DT_Offset_To_Top_Func (Node25)
- -- Has_Biased_Representation (Flag139)
- -- Has_Per_Object_Constraint (Flag154)
- -- Is_Atomic (Flag85)
- -- Is_Tag (Flag78)
- -- Is_Volatile (Flag16)
- -- Treat_As_Volatile (Flag41)
- -- Is_Return_Object (Flag209)
- -- Is_Protected_Private (synth)
- -- Next_Component (synth)
- -- Next_Tag_Component (synth)
+ -- Normalized_First_Bit (Uint8)
+ -- Current_Value (Node9) (always Empty)
+ -- Normalized_Position_Max (Uint10)
+ -- Component_Bit_Offset (Uint11)
+ -- Esize (Uint12)
+ -- Component_Clause (Node13)
+ -- Normalized_Position (Uint14)
+ -- DT_Entry_Count (Uint15)
+ -- Entry_Formal (Node16)
+ -- Prival (Node17)
+ -- Renamed_Object (Node18) (always Empty)
+ -- Discriminant_Checking_Func (Node20)
+ -- Interface_Name (Node21) (JGNAT usage only)
+ -- Original_Record_Component (Node22)
+ -- Protected_Operation (Node23)
+ -- DT_Offset_To_Top_Func (Node25)
+ -- Has_Biased_Representation (Flag139)
+ -- Has_Per_Object_Constraint (Flag154)
+ -- Is_Atomic (Flag85)
+ -- Is_Tag (Flag78)
+ -- Is_Volatile (Flag16)
+ -- Treat_As_Volatile (Flag41)
+ -- Is_Return_Object (Flag209)
+ -- Is_Protected_Private (synth)
+ -- Next_Component (synth)
+ -- Next_Component_Or_Discriminant (synth)
+ -- Next_Tag_Component (synth)
-- E_Constant
-- E_Loop_Parameter
- -- Current_Value (Node9) (always Empty)
- -- Discriminal_Link (Node10) (discriminals only)
- -- Full_View (Node11)
- -- Esize (Uint12)
- -- Alignment (Uint14)
- -- Actual_Subtype (Node17)
- -- Renamed_Object (Node18)
- -- Size_Check_Code (Node19) (constants only)
- -- In_Private_Part (Flag45)
- -- Interface_Name (Node21)
- -- Has_Alignment_Clause (Flag46)
- -- Has_Atomic_Components (Flag86)
- -- Has_Biased_Representation (Flag139)
- -- Has_Completion (Flag26) (constants only)
- -- Has_Size_Clause (Flag29)
- -- Has_Volatile_Components (Flag87)
- -- Is_Atomic (Flag85)
- -- Is_Eliminated (Flag124)
- -- Is_True_Constant (Flag163)
- -- Is_Volatile (Flag16)
- -- Never_Set_In_Source (Flag115)
- -- Treat_As_Volatile (Flag41)
- -- Is_Return_Object (Flag209)
- -- Address_Clause (synth)
- -- Alignment_Clause (synth)
- -- Constant_Value (synth)
- -- Size_Clause (synth)
+ -- Current_Value (Node9) (always Empty)
+ -- Discriminal_Link (Node10) (discriminals only)
+ -- Full_View (Node11)
+ -- Esize (Uint12)
+ -- Alignment (Uint14)
+ -- Actual_Subtype (Node17)
+ -- Renamed_Object (Node18)
+ -- Size_Check_Code (Node19) (constants only)
+ -- In_Private_Part (Flag45)
+ -- Interface_Name (Node21)
+ -- Has_Alignment_Clause (Flag46)
+ -- Has_Atomic_Components (Flag86)
+ -- Has_Biased_Representation (Flag139)
+ -- Has_Completion (Flag26) (constants only)
+ -- Has_Size_Clause (Flag29)
+ -- Has_Volatile_Components (Flag87)
+ -- Is_Atomic (Flag85)
+ -- Is_Eliminated (Flag124)
+ -- Is_True_Constant (Flag163)
+ -- Is_Volatile (Flag16)
+ -- Never_Set_In_Source (Flag115)
+ -- Treat_As_Volatile (Flag41)
+ -- Is_Return_Object (Flag209)
+ -- Address_Clause (synth)
+ -- Alignment_Clause (synth)
+ -- Constant_Value (synth)
+ -- Size_Clause (synth)
-- E_Decimal_Fixed_Point_Type
-- E_Decimal_Fixed_Subtype
- -- Scale_Value (Uint15)
- -- Digits_Value (Uint17)
- -- Scalar_Range (Node20)
- -- Delta_Value (Ureal18)
- -- Small_Value (Ureal21)
- -- Has_Machine_Radix_Clause (Flag83)
- -- Machine_Radix_10 (Flag84)
- -- Type_Low_Bound (synth)
- -- Type_High_Bound (synth)
- -- (plus type attributes)
+ -- Scale_Value (Uint15)
+ -- Digits_Value (Uint17)
+ -- Scalar_Range (Node20)
+ -- Delta_Value (Ureal18)
+ -- Small_Value (Ureal21)
+ -- Has_Machine_Radix_Clause (Flag83)
+ -- Machine_Radix_10 (Flag84)
+ -- Type_Low_Bound (synth)
+ -- Type_High_Bound (synth)
+ -- (plus type attributes)
-- E_Discriminant
- -- Normalized_First_Bit (Uint8)
- -- Current_Value (Node9) (always Empty)
- -- Normalized_Position_Max (Uint10)
- -- Component_Bit_Offset (Uint11)
- -- Esize (Uint12)
- -- Component_Clause (Node13)
- -- Normalized_Position (Uint14)
- -- Discriminant_Number (Uint15)
- -- Discriminal (Node17)
- -- Renamed_Object (Node18) (always Empty)
- -- Corresponding_Discriminant (Node19)
- -- Discriminant_Default_Value (Node20)
- -- Interface_Name (Node21) (JGNAT usage only)
- -- Original_Record_Component (Node22)
- -- CR_Discriminant (Node23)
- -- Is_Return_Object (Flag209)
- -- Next_Discriminant (synth)
- -- Next_Stored_Discriminant (synth)
+ -- Normalized_First_Bit (Uint8)
+ -- Current_Value (Node9) (always Empty)
+ -- Normalized_Position_Max (Uint10)
+ -- Component_Bit_Offset (Uint11)
+ -- Esize (Uint12)
+ -- Component_Clause (Node13)
+ -- Normalized_Position (Uint14)
+ -- Discriminant_Number (Uint15)
+ -- Discriminal (Node17)
+ -- Renamed_Object (Node18) (always Empty)
+ -- Corresponding_Discriminant (Node19)
+ -- Discriminant_Default_Value (Node20)
+ -- Interface_Name (Node21) (JGNAT usage only)
+ -- Original_Record_Component (Node22)
+ -- CR_Discriminant (Node23)
+ -- Is_Return_Object (Flag209)
+ -- Next_Component_Or_Discriminant (synth)
+ -- Next_Discriminant (synth)
+ -- Next_Stored_Discriminant (synth)
-- E_Entry
-- E_Entry_Family
- -- Protected_Body_Subprogram (Node11)
- -- Barrier_Function (Node12)
- -- Entry_Parameters_Type (Node15)
- -- First_Entity (Node17)
- -- Alias (Node18) (Entry only. Always empty)
- -- Finalization_Chain_Entity (Node19)
- -- Last_Entity (Node20)
- -- Accept_Address (Elist21)
- -- Scope_Depth_Value (Uint22)
- -- Privals_Chain (Elist23) (for a protected entry)
- -- Default_Expressions_Processed (Flag108)
- -- Entry_Accepted (Flag152)
- -- Is_AST_Entry (Flag132) (for entry only)
- -- Needs_No_Actuals (Flag22)
- -- Sec_Stack_Needed_For_Return (Flag167)
- -- Uses_Sec_Stack (Flag95)
- -- Address_Clause (synth)
- -- First_Formal (synth)
- -- First_Formal_With_Extras (synth)
- -- Entry_Index_Type (synth)
- -- Number_Formals (synth)
- -- Scope_Depth (synth)
+ -- Protected_Body_Subprogram (Node11)
+ -- Barrier_Function (Node12)
+ -- Entry_Parameters_Type (Node15)
+ -- First_Entity (Node17)
+ -- Alias (Node18) (for entry only. Empty)
+ -- Finalization_Chain_Entity (Node19)
+ -- Last_Entity (Node20)
+ -- Accept_Address (Elist21)
+ -- Scope_Depth_Value (Uint22)
+ -- Privals_Chain (Elist23) (for a protected entry)
+ -- Default_Expressions_Processed (Flag108)
+ -- Entry_Accepted (Flag152)
+ -- Is_AST_Entry (Flag132) (for entry only)
+ -- Needs_No_Actuals (Flag22)
+ -- Sec_Stack_Needed_For_Return (Flag167)
+ -- Uses_Sec_Stack (Flag95)
+ -- Address_Clause (synth)
+ -- First_Formal (synth)
+ -- First_Formal_With_Extras (synth)
+ -- Entry_Index_Type (synth)
+ -- Number_Formals (synth)
+ -- Scope_Depth (synth)
-- E_Entry_Index_Parameter
- -- Entry_Index_Constant (Node18)
+ -- Entry_Index_Constant (Node18)
-- E_Enumeration_Literal
- -- Enumeration_Pos (Uint11)
- -- Enumeration_Rep (Uint12)
- -- Debug_Renaming_Link (Node13)
- -- Alias (Node18)
- -- Enumeration_Rep_Expr (Node22)
- -- Next_Literal (synth)
+ -- Enumeration_Pos (Uint11)
+ -- Enumeration_Rep (Uint12)
+ -- Debug_Renaming_Link (Node13)
+ -- Alias (Node18)
+ -- Enumeration_Rep_Expr (Node22)
+ -- Next_Literal (synth)
-- E_Enumeration_Type
-- E_Enumeration_Subtype
- -- Lit_Indexes (Node15) (root type only)
- -- Lit_Strings (Node16) (root type only)
- -- First_Literal (Node17)
- -- Scalar_Range (Node20)
- -- Enum_Pos_To_Rep (Node23) (type only, not subtype)
- -- Has_Biased_Representation (Flag139)
- -- Has_Contiguous_Rep (Flag181)
- -- Has_Enumeration_Rep_Clause (Flag66)
- -- Nonzero_Is_True (Flag162) (base type only)
- -- Type_Low_Bound (synth)
- -- Type_High_Bound (synth)
- -- (plus type attributes)
+ -- Lit_Indexes (Node15) (root type only)
+ -- Lit_Strings (Node16) (root type only)
+ -- First_Literal (Node17)
+ -- Scalar_Range (Node20)
+ -- Enum_Pos_To_Rep (Node23) (type only)
+ -- Has_Biased_Representation (Flag139)
+ -- Has_Contiguous_Rep (Flag181)
+ -- Has_Enumeration_Rep_Clause (Flag66)
+ -- Nonzero_Is_True (Flag162) (base type only)
+ -- Type_Low_Bound (synth)
+ -- Type_High_Bound (synth)
+ -- (plus type attributes)
-- E_Exception
- -- Alignment (Uint14)
- -- Renamed_Entity (Node18)
- -- Register_Exception_Call (Node20)
- -- Interface_Name (Node21)
- -- Exception_Code (Uint22)
- -- Discard_Names (Flag88)
- -- Is_VMS_Exception (Flag133)
+ -- Alignment (Uint14)
+ -- Renamed_Entity (Node18)
+ -- Register_Exception_Call (Node20)
+ -- Interface_Name (Node21)
+ -- Exception_Code (Uint22)
+ -- Discard_Names (Flag88)
+ -- Is_VMS_Exception (Flag133)
-- E_Exception_Type
- -- Equivalent_Type (Node18)
- -- (plus type attributes)
+ -- Equivalent_Type (Node18)
+ -- (plus type attributes)
-- E_Floating_Point_Type
-- E_Floating_Point_Subtype
- -- Digits_Value (Uint17)
- -- Scalar_Range (Node20)
- -- Type_Low_Bound (synth)
- -- Type_High_Bound (synth)
- -- (plus type attributes)
+ -- Digits_Value (Uint17)
+ -- Scalar_Range (Node20)
+ -- Type_Low_Bound (synth)
+ -- Type_High_Bound (synth)
+ -- (plus type attributes)
-- E_Function
-- E_Generic_Function
- -- Mechanism (Uint8) (returns Mechanism_Type)
- -- Renaming_Map (Uint9)
- -- Handler_Records (List10) (non-generic case only)
- -- Protected_Body_Subprogram (Node11)
- -- Next_Inlined_Subprogram (Node12)
- -- Corresponding_Equality (Node13) (implicit /= only)
- -- Elaboration_Entity (Node13) (all other cases)
- -- First_Optional_Parameter (Node14) (non-generic case only)
- -- DT_Position (Uint15)
- -- DTC_Entity (Node16)
- -- First_Entity (Node17)
- -- Alias (Node18) (non-generic case only)
- -- Renamed_Entity (Node18) (generic case only)
- -- Finalization_Chain_Entity (Node19)
- -- Last_Entity (Node20)
- -- Interface_Name (Node21)
- -- Scope_Depth_Value (Uint22)
- -- Generic_Renamings (Elist23) (for an instance)
- -- Inner_Instances (Elist23) (for a generic function)
- -- Privals_Chain (Elist23) (for a protected function)
- -- Abstract_Interface_Alias (Node25)
- -- Overridden_Operation (Node26)
- -- Extra_Formals (Node28)
- -- Body_Needed_For_SAL (Flag40)
- -- Elaboration_Entity_Required (Flag174)
- -- Function_Returns_With_DSP (Flag169)
- -- Default_Expressions_Processed (Flag108)
- -- Delay_Cleanups (Flag114)
- -- Delay_Subprogram_Descriptors (Flag50)
- -- Discard_Names (Flag88)
- -- Has_Completion (Flag26)
- -- Has_Controlling_Result (Flag98)
- -- Has_Master_Entity (Flag21)
- -- Has_Missing_Return (Flag142)
- -- Has_Nested_Block_With_Handler (Flag101)
- -- Has_Recursive_Call (Flag143)
- -- Has_Subprogram_Descriptor (Flag93)
- -- Is_Abstract (Flag19)
- -- Is_Called (Flag102) (non-generic case only)
- -- Is_Constructor (Flag76)
- -- Is_Discrim_SO_Function (Flag176)
- -- Is_Eliminated (Flag124)
- -- Is_Instantiated (Flag126) (generic case only)
- -- Is_Intrinsic_Subprogram (Flag64)
- -- Is_Machine_Code_Subprogram (Flag137) (non-generic case only)
- -- Is_Overriding_Operation (Flag39) (non-generic case only)
- -- Is_Private_Descendant (Flag53)
- -- Is_Pure (Flag44)
- -- Is_Thread_Body (Flag77) (non-generic case only)
- -- Is_Visible_Child_Unit (Flag116)
- -- Needs_No_Actuals (Flag22)
- -- Return_Present (Flag54)
- -- Returns_By_Ref (Flag90)
- -- Sec_Stack_Needed_For_Return (Flag167)
- -- Uses_Sec_Stack (Flag95)
- -- Address_Clause (synth)
- -- First_Formal (synth)
- -- First_Formal_With_Extras (synth)
- -- Number_Formals (synth)
- -- Scope_Depth (synth)
+ -- Mechanism (Uint8) (Mechanism_Type)
+ -- Renaming_Map (Uint9)
+ -- Handler_Records (List10) (non-generic case only)
+ -- Protected_Body_Subprogram (Node11)
+ -- Next_Inlined_Subprogram (Node12)
+ -- Corresponding_Equality (Node13) (implicit /= only)
+ -- Elaboration_Entity (Node13) (all other cases)
+ -- First_Optional_Parameter (Node14) (non-generic case only)
+ -- DT_Position (Uint15)
+ -- DTC_Entity (Node16)
+ -- First_Entity (Node17)
+ -- Alias (Node18) (non-generic case only)
+ -- Renamed_Entity (Node18) (generic case only)
+ -- Finalization_Chain_Entity (Node19)
+ -- Last_Entity (Node20)
+ -- Interface_Name (Node21)
+ -- Scope_Depth_Value (Uint22)
+ -- Generic_Renamings (Elist23) (for an instance)
+ -- Inner_Instances (Elist23) (generic function only)
+ -- Privals_Chain (Elist23) (protected func only)
+ -- Abstract_Interface_Alias (Node25)
+ -- Overridden_Operation (Node26)
+ -- Extra_Formals (Node28)
+ -- Body_Needed_For_SAL (Flag40)
+ -- Elaboration_Entity_Required (Flag174)
+ -- Function_Returns_With_DSP (Flag169)
+ -- Default_Expressions_Processed (Flag108)
+ -- Delay_Cleanups (Flag114)
+ -- Delay_Subprogram_Descriptors (Flag50)
+ -- Discard_Names (Flag88)
+ -- Has_Completion (Flag26)
+ -- Has_Controlling_Result (Flag98)
+ -- Has_Master_Entity (Flag21)
+ -- Has_Missing_Return (Flag142)
+ -- Has_Nested_Block_With_Handler (Flag101)
+ -- Has_Recursive_Call (Flag143)
+ -- Has_Subprogram_Descriptor (Flag93)
+ -- Is_Abstract_Subprogram (Flag19) (non-generic case only)
+ -- Is_Called (Flag102) (non-generic case only)
+ -- Is_Constructor (Flag76)
+ -- Is_Discrim_SO_Function (Flag176)
+ -- Is_Eliminated (Flag124)
+ -- Is_Instantiated (Flag126) (generic case only)
+ -- Is_Intrinsic_Subprogram (Flag64)
+ -- Is_Machine_Code_Subprogram (Flag137) (non-generic case only)
+ -- Is_Overriding_Operation (Flag39) (non-generic case only)
+ -- Is_Private_Descendant (Flag53)
+ -- Is_Pure (Flag44)
+ -- Is_Thread_Body (Flag77) (non-generic case only)
+ -- Is_Visible_Child_Unit (Flag116)
+ -- Needs_No_Actuals (Flag22)
+ -- Requires_Overriding (Flag213) (non-generic case only)
+ -- Return_Present (Flag54)
+ -- Returns_By_Ref (Flag90)
+ -- Sec_Stack_Needed_For_Return (Flag167)
+ -- Uses_Sec_Stack (Flag95)
+ -- Address_Clause (synth)
+ -- First_Formal (synth)
+ -- First_Formal_With_Extras (synth)
+ -- Number_Formals (synth)
+ -- Scope_Depth (synth)
-- E_General_Access_Type
- -- Storage_Size_Variable (Node15) (base type only)
- -- Master_Id (Node17)
- -- Directly_Designated_Type (Node20)
- -- Associated_Storage_Pool (Node22) (base type only)
- -- Associated_Final_Chain (Node23)
+ -- Storage_Size_Variable (Node15) (base type only)
+ -- Master_Id (Node17)
+ -- Directly_Designated_Type (Node20)
+ -- Associated_Storage_Pool (Node22) (base type only)
+ -- Associated_Final_Chain (Node23)
-- (plus type attributes)
-- E_Generic_In_Parameter
-- E_Generic_In_Out_Parameter
- -- Current_Value (Node9) (always Empty)
- -- Entry_Component (Node11)
- -- Actual_Subtype (Node17)
- -- Renamed_Object (Node18) (always Empty)
- -- Default_Value (Node20)
- -- Protected_Formal (Node22)
- -- Is_Controlling_Formal (Flag97)
- -- Is_Entry_Formal (Flag52)
- -- Is_Return_Object (Flag209)
- -- Parameter_Mode (synth)
+ -- Current_Value (Node9) (always Empty)
+ -- Entry_Component (Node11)
+ -- Actual_Subtype (Node17)
+ -- Renamed_Object (Node18) (always Empty)
+ -- Default_Value (Node20)
+ -- Protected_Formal (Node22)
+ -- Is_Controlling_Formal (Flag97)
+ -- Is_Entry_Formal (Flag52)
+ -- Is_Return_Object (Flag209)
+ -- Parameter_Mode (synth)
-- E_Incomplete_Type
-- E_Incomplete_Subtype
- -- Non_Limited_View (Node17)
- -- Private_Dependents (Elist18)
- -- Discriminant_Constraint (Elist21)
- -- Stored_Constraint (Elist23)
- -- First_Discriminant (synth)
- -- First_Stored_Discriminant (synth)
+ -- Non_Limited_View (Node17)
+ -- Private_Dependents (Elist18)
+ -- Discriminant_Constraint (Elist21)
+ -- Stored_Constraint (Elist23)
+ -- First_Discriminant (synth)
+ -- First_Stored_Discriminant (synth)
-- (plus type attributes)
-- E_In_Parameter
-- E_In_Out_Parameter
-- E_Out_Parameter
- -- Mechanism (Uint8) (returns Mechanism_Type)
- -- Current_Value (Node9)
- -- Discriminal_Link (Node10) (discriminals only)
- -- Entry_Component (Node11)
- -- Esize (Uint12)
- -- Extra_Accessibility (Node13)
- -- Alignment (Uint14)
- -- Extra_Formal (Node15)
- -- Unset_Reference (Node16)
- -- Actual_Subtype (Node17)
- -- Renamed_Object (Node18)
- -- Spec_Entity (Node19)
- -- Default_Value (Node20)
- -- Default_Expr_Function (Node21)
- -- Protected_Formal (Node22)
- -- Extra_Constrained (Node23)
- -- Is_Controlling_Formal (Flag97)
- -- Is_Entry_Formal (Flag52)
- -- Is_Optional_Parameter (Flag134)
- -- Low_Bound_Known (Flag205)
- -- Never_Set_In_Source (Flag115)
- -- Is_Return_Object (Flag209)
- -- Parameter_Mode (synth)
+ -- Mechanism (Uint8) (Mechanism_Type)
+ -- Current_Value (Node9)
+ -- Discriminal_Link (Node10) (discriminals only)
+ -- Entry_Component (Node11)
+ -- Esize (Uint12)
+ -- Extra_Accessibility (Node13)
+ -- Alignment (Uint14)
+ -- Extra_Formal (Node15)
+ -- Unset_Reference (Node16)
+ -- Actual_Subtype (Node17)
+ -- Renamed_Object (Node18)
+ -- Spec_Entity (Node19)
+ -- Default_Value (Node20)
+ -- Default_Expr_Function (Node21)
+ -- Protected_Formal (Node22)
+ -- Extra_Constrained (Node23)
+ -- Is_Controlling_Formal (Flag97)
+ -- Is_Entry_Formal (Flag52)
+ -- Is_Optional_Parameter (Flag134)
+ -- Low_Bound_Known (Flag205)
+ -- Never_Set_In_Source (Flag115)
+ -- Is_Return_Object (Flag209)
+ -- Parameter_Mode (synth)
-- E_Label
- -- Enclosing_Scope (Node18)
- -- Reachable (Flag49)
+ -- Enclosing_Scope (Node18)
+ -- Reachable (Flag49)
-- E_Limited_Private_Type
-- E_Limited_Private_Subtype
- -- First_Entity (Node17)
- -- Private_Dependents (Elist18)
- -- Underlying_Full_View (Node19)
- -- Last_Entity (Node20)
- -- Discriminant_Constraint (Elist21)
- -- Private_View (Node22)
- -- Stored_Constraint (Elist23)
- -- Has_Completion (Flag26)
- -- First_Discriminant (synth)
- -- First_Stored_Discriminant (synth)
+ -- First_Entity (Node17)
+ -- Private_Dependents (Elist18)
+ -- Underlying_Full_View (Node19)
+ -- Last_Entity (Node20)
+ -- Discriminant_Constraint (Elist21)
+ -- Private_View (Node22)
+ -- Stored_Constraint (Elist23)
+ -- Has_Completion (Flag26)
+ -- First_Discriminant (synth)
+ -- First_Stored_Discriminant (synth)
-- (plus type attributes)
-- E_Loop
- -- Has_Exit (Flag47)
- -- Has_Master_Entity (Flag21)
- -- Has_Nested_Block_With_Handler (Flag101)
+ -- Has_Exit (Flag47)
+ -- Has_Master_Entity (Flag21)
+ -- Has_Nested_Block_With_Handler (Flag101)
-- E_Modular_Integer_Type
-- E_Modular_Integer_Subtype
- -- Modulus (Uint17) (base type only)
- -- Original_Array_Type (Node21)
- -- Scalar_Range (Node20)
- -- Non_Binary_Modulus (Flag58) (base type only)
- -- Has_Biased_Representation (Flag139)
- -- Type_Low_Bound (synth)
- -- Type_High_Bound (synth)
+ -- Modulus (Uint17) (base type only)
+ -- Original_Array_Type (Node21)
+ -- Scalar_Range (Node20)
+ -- Non_Binary_Modulus (Flag58) (base type only)
+ -- Has_Biased_Representation (Flag139)
+ -- Type_Low_Bound (synth)
+ -- Type_High_Bound (synth)
-- (plus type attributes)
-- E_Named_Integer
- -- Constant_Value (synth)
+ -- Constant_Value (synth)
-- E_Named_Real
- -- Constant_Value (synth)
+ -- Constant_Value (synth)
-- E_Operator
- -- First_Entity (Node17)
- -- Alias (Node18)
- -- Last_Entity (Node20)
- -- Is_Machine_Code_Subprogram (Flag137)
- -- Is_Pure (Flag44)
- -- Is_Intrinsic_Subprogram (Flag64)
- -- Is_Overriding_Operation (Flag39)
- -- Default_Expressions_Processed (Flag108)
+ -- First_Entity (Node17)
+ -- Alias (Node18)
+ -- Last_Entity (Node20)
+ -- Is_Machine_Code_Subprogram (Flag137)
+ -- Is_Pure (Flag44)
+ -- Is_Intrinsic_Subprogram (Flag64)
+ -- Is_Overriding_Operation (Flag39)
+ -- Default_Expressions_Processed (Flag108)
-- E_Ordinary_Fixed_Point_Type
-- E_Ordinary_Fixed_Point_Subtype
- -- Delta_Value (Ureal18)
- -- Scalar_Range (Node20)
- -- Small_Value (Ureal21)
- -- Has_Small_Clause (Flag67)
- -- Type_Low_Bound (synth)
- -- Type_High_Bound (synth)
- -- (plus type attributes)
+ -- Delta_Value (Ureal18)
+ -- Scalar_Range (Node20)
+ -- Small_Value (Ureal21)
+ -- Has_Small_Clause (Flag67)
+ -- Type_Low_Bound (synth)
+ -- Type_High_Bound (synth)
+ -- (plus type attributes)
-- E_Package
-- E_Generic_Package
- -- Dependent_Instances (Elist8) (for an instance)
- -- Renaming_Map (Uint9)
- -- Handler_Records (List10) (non-generic case only)
- -- Generic_Homonym (Node11) (generic case only)
- -- Associated_Formal_Package (Node12)
- -- Elaboration_Entity (Node13)
- -- Shadow_Entities (List14)
- -- Related_Instance (Node15) (non-generic case only)
- -- First_Private_Entity (Node16)
- -- First_Entity (Node17)
- -- Renamed_Entity (Node18)
- -- Body_Entity (Node19)
- -- Last_Entity (Node20)
- -- Interface_Name (Node21)
- -- Scope_Depth_Value (Uint22)
- -- Generic_Renamings (Elist23) (for an instance)
- -- Inner_Instances (Elist23) (generic case only)
- -- Limited_View (Node23) (non-generic, not instance)
- -- Current_Use_Clause (Node25)
- -- Package_Instantiation (Node26)
- -- Delay_Subprogram_Descriptors (Flag50)
- -- Body_Needed_For_SAL (Flag40)
- -- Discard_Names (Flag88)
- -- Elaboration_Entity_Required (Flag174)
- -- Elaborate_Body_Desirable (Flag210) (non-generic case only)
- -- From_With_Type (Flag159)
- -- Has_All_Calls_Remote (Flag79)
- -- Has_Completion (Flag26)
- -- Has_Forward_Instantiation (Flag175)
- -- Has_Master_Entity (Flag21)
- -- Has_Subprogram_Descriptor (Flag93)
- -- In_Package_Body (Flag48)
- -- In_Private_Part (Flag45)
- -- In_Use (Flag8)
- -- Is_Instantiated (Flag126)
- -- Is_Private_Descendant (Flag53)
- -- Is_Visible_Child_Unit (Flag116)
- -- Is_Wrapper_Package (synth) (non-generic case only)
- -- Scope_Depth (synth)
+ -- Dependent_Instances (Elist8) (for an instance)
+ -- Renaming_Map (Uint9)
+ -- Handler_Records (List10) (non-generic case only)
+ -- Generic_Homonym (Node11) (generic case only)
+ -- Associated_Formal_Package (Node12)
+ -- Elaboration_Entity (Node13)
+ -- Shadow_Entities (List14)
+ -- Related_Instance (Node15) (non-generic case only)
+ -- First_Private_Entity (Node16)
+ -- First_Entity (Node17)
+ -- Renamed_Entity (Node18)
+ -- Body_Entity (Node19)
+ -- Last_Entity (Node20)
+ -- Interface_Name (Node21)
+ -- Scope_Depth_Value (Uint22)
+ -- Generic_Renamings (Elist23) (for an instance)
+ -- Inner_Instances (Elist23) (generic case only)
+ -- Limited_View (Node23) (non-generic/instance)
+ -- Current_Use_Clause (Node25)
+ -- Package_Instantiation (Node26)
+ -- Delay_Subprogram_Descriptors (Flag50)
+ -- Body_Needed_For_SAL (Flag40)
+ -- Discard_Names (Flag88)
+ -- Elaboration_Entity_Required (Flag174)
+ -- Elaborate_Body_Desirable (Flag210) (non-generic case only)
+ -- From_With_Type (Flag159)
+ -- Has_All_Calls_Remote (Flag79)
+ -- Has_Completion (Flag26)
+ -- Has_Forward_Instantiation (Flag175)
+ -- Has_Master_Entity (Flag21)
+ -- Has_RACW (Flag214) (non-generic case only)
+ -- Has_Subprogram_Descriptor (Flag93)
+ -- In_Package_Body (Flag48)
+ -- In_Private_Part (Flag45)
+ -- In_Use (Flag8)
+ -- Is_Instantiated (Flag126)
+ -- Is_Private_Descendant (Flag53)
+ -- Is_Visible_Child_Unit (Flag116)
+ -- Is_Wrapper_Package (synth) (non-generic case only)
+ -- Scope_Depth (synth)
-- E_Package_Body
- -- Handler_Records (List10) (non-generic case only)
- -- Related_Instance (Node15) (non-generic case only)
- -- First_Entity (Node17)
- -- Spec_Entity (Node19)
- -- Last_Entity (Node20)
- -- Scope_Depth_Value (Uint22)
- -- Scope_Depth (synth)
- -- Delay_Subprogram_Descriptors (Flag50)
- -- Has_Subprogram_Descriptor (Flag93)
+ -- Handler_Records (List10) (non-generic case only)
+ -- Related_Instance (Node15) (non-generic case only)
+ -- First_Entity (Node17)
+ -- Spec_Entity (Node19)
+ -- Last_Entity (Node20)
+ -- Scope_Depth_Value (Uint22)
+ -- Scope_Depth (synth)
+ -- Delay_Subprogram_Descriptors (Flag50)
+ -- Has_Subprogram_Descriptor (Flag93)
-- E_Private_Type
-- E_Private_Subtype
- -- Primitive_Operations (Elist15)
- -- First_Entity (Node17)
- -- Private_Dependents (Elist18)
- -- Underlying_Full_View (Node19)
- -- Last_Entity (Node20)
- -- Discriminant_Constraint (Elist21)
- -- Private_View (Node22)
- -- Stored_Constraint (Elist23)
- -- Has_Completion (Flag26)
- -- Is_Controlled (Flag42) (base type only)
- -- Is_For_Access_Subtype (Flag118) (subtype only)
- -- First_Discriminant (synth)
- -- First_Stored_Discriminant (synth)
+ -- Primitive_Operations (Elist15)
+ -- First_Entity (Node17)
+ -- Private_Dependents (Elist18)
+ -- Underlying_Full_View (Node19)
+ -- Last_Entity (Node20)
+ -- Discriminant_Constraint (Elist21)
+ -- Private_View (Node22)
+ -- Stored_Constraint (Elist23)
+ -- Has_Completion (Flag26)
+ -- Is_Controlled (Flag42) (base type only)
+ -- Is_For_Access_Subtype (Flag118) (subtype only)
+ -- First_Discriminant (synth)
+ -- First_Stored_Discriminant (synth)
-- (plus type attributes)
-- E_Procedure
-- E_Generic_Procedure
- -- Renaming_Map (Uint9)
- -- Handler_Records (List10) (non-generic case only)
- -- Protected_Body_Subprogram (Node11)
- -- Next_Inlined_Subprogram (Node12)
- -- Elaboration_Entity (Node13)
- -- First_Optional_Parameter (Node14) (non-generic case only)
- -- DT_Position (Uint15)
- -- DTC_Entity (Node16)
- -- First_Entity (Node17)
- -- Alias (Node18) (non-generic case only)
- -- Renamed_Entity (Node18) (generic case only)
- -- Finalization_Chain_Entity (Node19)
- -- Last_Entity (Node20)
- -- Interface_Name (Node21)
- -- Scope_Depth_Value (Uint22)
- -- Scope_Depth (synth)
- -- Generic_Renamings (Elist23) (for an instance)
- -- Inner_Instances (Elist23) (for a generic procedure)
- -- Privals_Chain (Elist23) (for a protected procedure)
- -- Abstract_Interface_Alias (Node25)
- -- Overridden_Operation (Node26)
- -- Wrapped_Entity (Node27) (non-generic case only)
- -- Extra_Formals (Node28)
- -- Body_Needed_For_SAL (Flag40)
- -- Elaboration_Entity_Required (Flag174)
- -- Function_Returns_With_DSP (Flag169) (always False for procedure)
- -- Default_Expressions_Processed (Flag108)
- -- Delay_Cleanups (Flag114)
- -- Delay_Subprogram_Descriptors (Flag50)
- -- Discard_Names (Flag88)
- -- Has_Completion (Flag26)
- -- Has_Master_Entity (Flag21)
- -- Has_Nested_Block_With_Handler (Flag101)
- -- Has_Subprogram_Descriptor (Flag93)
- -- Is_Visible_Child_Unit (Flag116)
- -- Is_Abstract (Flag19)
- -- Is_Asynchronous (Flag81)
- -- Is_Called (Flag102) (non-generic subprogram)
- -- Is_Constructor (Flag76)
- -- Is_Eliminated (Flag124)
- -- Is_Instantiated (Flag126) (generic case only)
- -- Is_Interrupt_Handler (Flag89)
- -- Is_Intrinsic_Subprogram (Flag64)
- -- Is_Machine_Code_Subprogram (Flag137) (non-generic case only)
- -- Is_Null_Init_Proc (Flag178)
- -- Is_Overriding_Operation (Flag39) (non-generic case only)
- -- Is_Primitive_Wrapper (Flag195) (non-generic case only)
- -- Is_Private_Descendant (Flag53)
- -- Is_Pure (Flag44)
- -- Is_Thread_Body (Flag77) (non-generic case only)
- -- Is_Valued_Procedure (Flag127)
- -- Is_Visible_Child_Unit (Flag116)
- -- Needs_No_Actuals (Flag22)
- -- No_Return (Flag113)
- -- Sec_Stack_Needed_For_Return (Flag167)
- -- Address_Clause (synth)
- -- First_Formal (synth)
- -- First_Formal_With_Extras (synth)
- -- Number_Formals (synth)
+ -- Renaming_Map (Uint9)
+ -- Handler_Records (List10) (non-generic case only)
+ -- Protected_Body_Subprogram (Node11)
+ -- Next_Inlined_Subprogram (Node12)
+ -- Elaboration_Entity (Node13)
+ -- First_Optional_Parameter (Node14) (non-generic case only)
+ -- DT_Position (Uint15)
+ -- DTC_Entity (Node16)
+ -- First_Entity (Node17)
+ -- Alias (Node18) (non-generic case only)
+ -- Renamed_Entity (Node18) (generic case only)
+ -- Finalization_Chain_Entity (Node19)
+ -- Last_Entity (Node20)
+ -- Interface_Name (Node21)
+ -- Scope_Depth_Value (Uint22)
+ -- Generic_Renamings (Elist23) (for instance)
+ -- Inner_Instances (Elist23) (for generic proc)
+ -- Privals_Chain (Elist23) (for protected proc)
+ -- Abstract_Interface_Alias (Node25)
+ -- Overridden_Operation (Node26)
+ -- Wrapped_Entity (Node27) (non-generic case only)
+ -- Extra_Formals (Node28)
+ -- Body_Needed_For_SAL (Flag40)
+ -- Delay_Cleanups (Flag114)
+ -- Discard_Names (Flag88)
+ -- Elaboration_Entity_Required (Flag174)
+ -- Function_Returns_With_DSP (Flag169) (false for procedure)
+ -- Default_Expressions_Processed (Flag108)
+ -- Delay_Cleanups (Flag114)
+ -- Delay_Subprogram_Descriptors (Flag50)
+ -- Discard_Names (Flag88)
+ -- Has_Completion (Flag26)
+ -- Has_Master_Entity (Flag21)
+ -- Has_Nested_Block_With_Handler (Flag101)
+ -- Has_Subprogram_Descriptor (Flag93)
+ -- Is_Visible_Child_Unit (Flag116)
+ -- Is_Abstract_Subprogram (Flag19) (non-generic case only)
+ -- Is_Asynchronous (Flag81)
+ -- Is_Called (Flag102) (non-generic subprog)
+ -- Is_Constructor (Flag76)
+ -- Is_Eliminated (Flag124)
+ -- Is_Instantiated (Flag126) (generic case only)
+ -- Is_Interrupt_Handler (Flag89)
+ -- Is_Intrinsic_Subprogram (Flag64)
+ -- Is_Machine_Code_Subprogram (Flag137) (non-generic case only)
+ -- Is_Null_Init_Proc (Flag178)
+ -- Is_Overriding_Operation (Flag39) (non-generic case only)
+ -- Is_Primitive_Wrapper (Flag195) (non-generic case only)
+ -- Is_Private_Descendant (Flag53)
+ -- Is_Pure (Flag44)
+ -- Is_Thread_Body (Flag77) (non-generic case only)
+ -- Is_Valued_Procedure (Flag127)
+ -- Is_Visible_Child_Unit (Flag116)
+ -- Needs_No_Actuals (Flag22)
+ -- No_Return (Flag113)
+ -- Requires_Overriding (Flag213) (non-generic case only)
+ -- Sec_Stack_Needed_For_Return (Flag167)
+ -- Address_Clause (synth)
+ -- First_Formal (synth)
+ -- First_Formal_With_Extras (synth)
+ -- Number_Formals (synth)
+ -- Delay_Cleanups (Flag114)
+ -- Discard_Names (Flag88)
-- E_Protected_Body
- -- Object_Ref (Node17)
+ -- Object_Ref (Node17)
-- (any others??? First/Last Entity, Scope_Depth???)
-- E_Protected_Object
-- E_Protected_Type
-- E_Protected_Subtype
- -- Entry_Bodies_Array (Node15)
- -- First_Private_Entity (Node16)
- -- First_Entity (Node17)
- -- Corresponding_Record_Type (Node18)
- -- Finalization_Chain_Entity (Node19)
- -- Last_Entity (Node20)
- -- Discriminant_Constraint (Elist21)
- -- Scope_Depth_Value (Uint22)
- -- Scope_Depth (synth)
- -- Stored_Constraint (Elist23)
- -- Has_Interrupt_Handler (synth)
- -- Sec_Stack_Needed_For_Return (Flag167) ???
- -- Uses_Sec_Stack (Flag95) ???
- -- Has_Entries (synth)
- -- Number_Entries (synth)
+ -- Entry_Bodies_Array (Node15)
+ -- First_Private_Entity (Node16)
+ -- First_Entity (Node17)
+ -- Corresponding_Record_Type (Node18)
+ -- Finalization_Chain_Entity (Node19)
+ -- Last_Entity (Node20)
+ -- Discriminant_Constraint (Elist21)
+ -- Scope_Depth_Value (Uint22)
+ -- Scope_Depth (synth)
+ -- Stored_Constraint (Elist23)
+ -- Has_Interrupt_Handler (synth)
+ -- Sec_Stack_Needed_For_Return (Flag167) ???
+ -- Uses_Sec_Stack (Flag95) ???
+ -- Has_Entries (synth)
+ -- Number_Entries (synth)
-- E_Record_Type
-- E_Record_Subtype
- -- Primitive_Operations (Elist15)
- -- Access_Disp_Table (Elist16) (base type only)
- -- Cloned_Subtype (Node16) (subtype case only)
- -- First_Entity (Node17)
- -- Corresponding_Concurrent_Type (Node18)
- -- Parent_Subtype (Node19)
- -- Last_Entity (Node20)
- -- Discriminant_Constraint (Elist21)
- -- Corresponding_Remote_Type (Node22)
- -- Stored_Constraint (Elist23)
- -- Abstract_Interfaces (Elist25)
- -- Component_Alignment (special) (base type only)
- -- C_Pass_By_Copy (Flag125) (base type only)
- -- Has_External_Tag_Rep_Clause (Flag110)
- -- Has_Record_Rep_Clause (Flag65) (base type only)
- -- Has_Static_Discriminants (Flag211) (subtype only)
- -- Is_Class_Wide_Equivalent_Type (Flag35)
- -- Is_Concurrent_Record_Type (Flag20)
- -- Is_Constrained (Flag12)
- -- Is_Controlled (Flag42) (base type only)
- -- Is_Interface (Flag186)
- -- Reverse_Bit_Order (Flag164) (base type only)
- -- First_Component (synth)
- -- First_Discriminant (synth)
- -- First_Stored_Discriminant (synth)
- -- First_Tag_Component (synth)
+ -- Primitive_Operations (Elist15)
+ -- Access_Disp_Table (Elist16) (base type only)
+ -- Cloned_Subtype (Node16) (subtype case only)
+ -- First_Entity (Node17)
+ -- Corresponding_Concurrent_Type (Node18)
+ -- Parent_Subtype (Node19)
+ -- Last_Entity (Node20)
+ -- Discriminant_Constraint (Elist21)
+ -- Corresponding_Remote_Type (Node22)
+ -- Stored_Constraint (Elist23)
+ -- Abstract_Interfaces (Elist25)
+ -- Component_Alignment (special) (base type only)
+ -- C_Pass_By_Copy (Flag125) (base type only)
+ -- Has_External_Tag_Rep_Clause (Flag110)
+ -- Has_Record_Rep_Clause (Flag65) (base type only)
+ -- Has_Static_Discriminants (Flag211) (subtype only)
+ -- Is_Class_Wide_Equivalent_Type (Flag35)
+ -- Is_Concurrent_Record_Type (Flag20)
+ -- Is_Constrained (Flag12)
+ -- Is_Controlled (Flag42) (base type only)
+ -- Is_Interface (Flag186)
+ -- Reverse_Bit_Order (Flag164) (base type only)
+ -- First_Component (synth)
+ -- First_Component_Or_Discriminant (synth)
+ -- First_Discriminant (synth)
+ -- First_Stored_Discriminant (synth)
+ -- First_Tag_Component (synth)
-- (plus type attributes)
-- E_Record_Type_With_Private
-- E_Record_Subtype_With_Private
- -- Primitive_Operations (Elist15)
- -- Access_Disp_Table (Elist16) (base type only)
- -- First_Entity (Node17)
- -- Private_Dependents (Elist18)
- -- Underlying_Full_View (Node19)
- -- Last_Entity (Node20)
- -- Discriminant_Constraint (Elist21)
- -- Private_View (Node22)
- -- Stored_Constraint (Elist23)
- -- Abstract_Interfaces (Elist25)
- -- Has_Completion (Flag26)
- -- Has_Record_Rep_Clause (Flag65) (base type only)
- -- Has_External_Tag_Rep_Clause (Flag110)
- -- Is_Concurrent_Record_Type (Flag20)
- -- Is_Constrained (Flag12)
- -- Is_Controlled (Flag42) (base type only)
- -- Is_Interface (Flag186)
- -- Reverse_Bit_Order (Flag164) (base type only)
- -- First_Component (synth)
- -- First_Discriminant (synth)
- -- First_Stored_Discriminant (synth)
- -- First_Tag_Component (synth)
+ -- Primitive_Operations (Elist15)
+ -- Access_Disp_Table (Elist16) (base type only)
+ -- First_Entity (Node17)
+ -- Private_Dependents (Elist18)
+ -- Underlying_Full_View (Node19)
+ -- Last_Entity (Node20)
+ -- Discriminant_Constraint (Elist21)
+ -- Private_View (Node22)
+ -- Stored_Constraint (Elist23)
+ -- Abstract_Interfaces (Elist25)
+ -- Has_Completion (Flag26)
+ -- Has_Record_Rep_Clause (Flag65) (base type only)
+ -- Has_External_Tag_Rep_Clause (Flag110)
+ -- Is_Concurrent_Record_Type (Flag20)
+ -- Is_Constrained (Flag12)
+ -- Is_Controlled (Flag42) (base type only)
+ -- Is_Interface (Flag186)
+ -- Reverse_Bit_Order (Flag164) (base type only)
+ -- First_Component (synth)
+ -- First_Component_Or_Discriminant (synth)
+ -- First_Discriminant (synth)
+ -- First_Stored_Discriminant (synth)
+ -- First_Tag_Component (synth)
-- (plus type attributes)
-- E_Return_Statement
- -- Return_Applies_To (Node8)
+ -- Return_Applies_To (Node8)
+ -- Finalization_Chain_Entity (Node19)
-- E_Signed_Integer_Type
-- E_Signed_Integer_Subtype
- -- Scalar_Range (Node20)
- -- Has_Biased_Representation (Flag139)
- -- Type_Low_Bound (synth)
- -- Type_High_Bound (synth)
+ -- Scalar_Range (Node20)
+ -- Has_Biased_Representation (Flag139)
+ -- Type_Low_Bound (synth)
+ -- Type_High_Bound (synth)
-- (plus type attributes)
-- E_String_Type
-- E_String_Subtype
- -- First_Index (Node17)
- -- Component_Type (Node20) (base type only)
- -- Is_Constrained (Flag12)
- -- Next_Index (synth)
- -- Number_Dimensions (synth)
+ -- First_Index (Node17)
+ -- Component_Type (Node20) (base type only)
+ -- Is_Constrained (Flag12)
+ -- Next_Index (synth)
+ -- Number_Dimensions (synth)
-- (plus type attributes)
-- E_String_Literal_Subtype
- -- String_Literal_Low_Bound (Node15)
- -- String_Literal_Length (Uint16)
- -- First_Index (Node17) (always Empty)
- -- Packed_Array_Type (Node23)
+ -- String_Literal_Low_Bound (Node15)
+ -- String_Literal_Length (Uint16)
+ -- First_Index (Node17) (always Empty)
+ -- Packed_Array_Type (Node23)
-- (plus type attributes)
-- E_Subprogram_Body
- -- Mechanism (Uint8)
- -- First_Entity (Node17)
- -- Last_Entity (Node20)
- -- Scope_Depth_Value (Uint22)
- -- Scope_Depth (synth)
+ -- Mechanism (Uint8)
+ -- First_Entity (Node17)
+ -- Last_Entity (Node20)
+ -- Scope_Depth_Value (Uint22)
+ -- Scope_Depth (synth)
-- E_Subprogram_Type
- -- Directly_Designated_Type (Node20)
- -- First_Formal (synth)
- -- First_Formal_With_Extras (synth)
- -- Number_Formals (synth)
- -- Function_Returns_With_DSP (Flag169)
+ -- Directly_Designated_Type (Node20)
+ -- First_Formal (synth)
+ -- First_Formal_With_Extras (synth)
+ -- Number_Formals (synth)
+ -- Function_Returns_With_DSP (Flag169)
-- (plus type attributes)
-- E_Task_Body
-- E_Task_Type
-- E_Task_Subtype
- -- Storage_Size_Variable (Node15) (base type only)
- -- First_Private_Entity (Node16)
- -- First_Entity (Node17)
- -- Corresponding_Record_Type (Node18)
- -- Finalization_Chain_Entity (Node19)
- -- Last_Entity (Node20)
- -- Discriminant_Constraint (Elist21)
- -- Scope_Depth_Value (Uint22)
- -- Scope_Depth (synth)
- -- Stored_Constraint (Elist23)
- -- Task_Body_Procedure (Node25)
- -- Delay_Cleanups (Flag114)
- -- Has_Master_Entity (Flag21)
- -- Has_Storage_Size_Clause (Flag23) (base type only)
- -- Uses_Sec_Stack (Flag95) ???
- -- Sec_Stack_Needed_For_Return (Flag167) ???
- -- Has_Entries (synth)
- -- Number_Entries (synth)
+ -- Storage_Size_Variable (Node15) (base type only)
+ -- First_Private_Entity (Node16)
+ -- First_Entity (Node17)
+ -- Corresponding_Record_Type (Node18)
+ -- Finalization_Chain_Entity (Node19)
+ -- Last_Entity (Node20)
+ -- Discriminant_Constraint (Elist21)
+ -- Scope_Depth_Value (Uint22)
+ -- Scope_Depth (synth)
+ -- Stored_Constraint (Elist23)
+ -- Task_Body_Procedure (Node25)
+ -- Delay_Cleanups (Flag114)
+ -- Has_Master_Entity (Flag21)
+ -- Has_Storage_Size_Clause (Flag23) (base type only)
+ -- Uses_Sec_Stack (Flag95) ???
+ -- Sec_Stack_Needed_For_Return (Flag167) ???
+ -- Has_Entries (synth)
+ -- Number_Entries (synth)
-- (plus type attributes)
-- E_Variable
- -- Hiding_Loop_Variable (Node8)
- -- Current_Value (Node9)
- -- Esize (Uint12)
- -- Extra_Accessibility (Node13)
- -- Alignment (Uint14)
- -- Shared_Var_Read_Proc (Node15)
- -- Unset_Reference (Node16)
- -- Actual_Subtype (Node17)
- -- Renamed_Object (Node18)
- -- Size_Check_Code (Node19)
- -- Last_Assignment (Node20)
- -- Interface_Name (Node21)
- -- Shared_Var_Assign_Proc (Node22)
- -- Extra_Constrained (Node23)
- -- Has_Alignment_Clause (Flag46)
- -- Has_Atomic_Components (Flag86)
- -- Has_Biased_Representation (Flag139)
- -- Has_Size_Clause (Flag29)
- -- Has_Volatile_Components (Flag87)
- -- In_Private_Part (Flag45)
- -- Is_Atomic (Flag85)
- -- Is_Eliminated (Flag124)
- -- Is_Shared_Passive (Flag60)
- -- Is_True_Constant (Flag163)
- -- Is_Volatile (Flag16)
- -- Never_Set_In_Source (Flag115)
- -- Treat_As_Volatile (Flag41)
- -- Is_Return_Object (Flag209)
- -- Address_Clause (synth)
- -- Alignment_Clause (synth)
- -- Constant_Value (synth)
- -- Size_Clause (synth)
+ -- Hiding_Loop_Variable (Node8)
+ -- Current_Value (Node9)
+ -- Esize (Uint12)
+ -- Extra_Accessibility (Node13)
+ -- Alignment (Uint14)
+ -- Shared_Var_Read_Proc (Node15)
+ -- Unset_Reference (Node16)
+ -- Actual_Subtype (Node17)
+ -- Renamed_Object (Node18)
+ -- Size_Check_Code (Node19)
+ -- Last_Assignment (Node20)
+ -- Interface_Name (Node21)
+ -- Shared_Var_Assign_Proc (Node22)
+ -- Extra_Constrained (Node23)
+ -- Has_Alignment_Clause (Flag46)
+ -- Has_Atomic_Components (Flag86)
+ -- Has_Biased_Representation (Flag139)
+ -- Has_Size_Clause (Flag29)
+ -- Has_Volatile_Components (Flag87)
+ -- In_Private_Part (Flag45)
+ -- Is_Atomic (Flag85)
+ -- Is_Eliminated (Flag124)
+ -- Is_Shared_Passive (Flag60)
+ -- Is_True_Constant (Flag163)
+ -- Is_Volatile (Flag16)
+ -- Never_Set_In_Source (Flag115)
+ -- Treat_As_Volatile (Flag41)
+ -- Is_Return_Object (Flag209)
+ -- Address_Clause (synth)
+ -- Alignment_Clause (synth)
+ -- Constant_Value (synth)
+ -- Size_Clause (synth)
-- E_Void
-- Since E_Void is the initial Ekind value of an entity when it is first
-- section contains the functions used to obtain attribute values which
-- correspond to values in fields or flags in the entity itself.
- function Abstract_Interfaces (Id : E) return L;
- function Accept_Address (Id : E) return L;
- function Access_Disp_Table (Id : E) return L;
- function Actual_Subtype (Id : E) return E;
- function Address_Taken (Id : E) return B;
- function Alias (Id : E) return E;
- function Abstract_Interface_Alias (Id : E) return E;
- function Alignment (Id : E) return U;
- function Associated_Final_Chain (Id : E) return E;
- function Associated_Formal_Package (Id : E) return E;
- function Associated_Node_For_Itype (Id : E) return N;
- function Associated_Storage_Pool (Id : E) return E;
- function Barrier_Function (Id : E) return N;
- function Block_Node (Id : E) return N;
- function Body_Entity (Id : E) return E;
- function Body_Needed_For_SAL (Id : E) return B;
- function CR_Discriminant (Id : E) return E;
- function C_Pass_By_Copy (Id : E) return B;
- function Can_Never_Be_Null (Id : E) return B;
- function Checks_May_Be_Suppressed (Id : E) return B;
- function Class_Wide_Type (Id : E) return E;
- function Cloned_Subtype (Id : E) return E;
- function Component_Alignment (Id : E) return C;
- function Component_Clause (Id : E) return N;
- function Component_Bit_Offset (Id : E) return U;
- function Component_Size (Id : E) return U;
- function Component_Type (Id : E) return E;
- function Corresponding_Concurrent_Type (Id : E) return E;
- function Corresponding_Discriminant (Id : E) return E;
- function Corresponding_Equality (Id : E) return E;
- function Corresponding_Record_Type (Id : E) return E;
- function Corresponding_Remote_Type (Id : E) return E;
- function Current_Use_Clause (Id : E) return E;
- function Current_Value (Id : E) return N;
- function Debug_Info_Off (Id : E) return B;
- function Debug_Renaming_Link (Id : E) return E;
- function DTC_Entity (Id : E) return E;
- function DT_Entry_Count (Id : E) return U;
- function DT_Offset_To_Top_Func (Id : E) return E;
- function DT_Position (Id : E) return U;
- function Default_Expr_Function (Id : E) return E;
- function Default_Expressions_Processed (Id : E) return B;
- function Default_Value (Id : E) return N;
- function Delay_Cleanups (Id : E) return B;
- function Delay_Subprogram_Descriptors (Id : E) return B;
- function Delta_Value (Id : E) return R;
- function Dependent_Instances (Id : E) return L;
- function Depends_On_Private (Id : E) return B;
- function Digits_Value (Id : E) return U;
- function Directly_Designated_Type (Id : E) return E;
- function Discard_Names (Id : E) return B;
- function Discriminal (Id : E) return E;
- function Discriminal_Link (Id : E) return E;
- function Discriminant_Checking_Func (Id : E) return E;
- function Discriminant_Constraint (Id : E) return L;
- function Discriminant_Default_Value (Id : E) return N;
- function Discriminant_Number (Id : E) return U;
- function Elaborate_Body_Desirable (Id : E) return B;
- function Elaboration_Entity (Id : E) return E;
- function Elaboration_Entity_Required (Id : E) return B;
- function Enclosing_Scope (Id : E) return E;
- function Entry_Accepted (Id : E) return B;
- function Entry_Bodies_Array (Id : E) return E;
- function Entry_Cancel_Parameter (Id : E) return E;
- function Entry_Component (Id : E) return E;
- function Entry_Formal (Id : E) return E;
- function Entry_Index_Constant (Id : E) return E;
- function Entry_Index_Type (Id : E) return E;
- function Entry_Parameters_Type (Id : E) return E;
- function Enum_Pos_To_Rep (Id : E) return E;
- function Enumeration_Pos (Id : E) return U;
- function Enumeration_Rep (Id : E) return U;
- function Enumeration_Rep_Expr (Id : E) return N;
- function Equivalent_Type (Id : E) return E;
- function Esize (Id : E) return U;
- function Exception_Code (Id : E) return U;
- function Extra_Accessibility (Id : E) return E;
- function Extra_Constrained (Id : E) return E;
- function Extra_Formal (Id : E) return E;
- function Extra_Formals (Id : E) return E;
- function Finalization_Chain_Entity (Id : E) return E;
- function Finalize_Storage_Only (Id : E) return B;
- function First_Entity (Id : E) return E;
- function First_Index (Id : E) return N;
- function First_Literal (Id : E) return E;
- function First_Optional_Parameter (Id : E) return E;
- function First_Private_Entity (Id : E) return E;
- function First_Rep_Item (Id : E) return N;
- function Freeze_Node (Id : E) return N;
- function From_With_Type (Id : E) return B;
- function Full_View (Id : E) return E;
- function Function_Returns_With_DSP (Id : E) return B;
- function Generic_Homonym (Id : E) return E;
- function Generic_Renamings (Id : E) return L;
- function Handler_Records (Id : E) return S;
- function Has_Aliased_Components (Id : E) return B;
- function Has_Alignment_Clause (Id : E) return B;
- function Has_All_Calls_Remote (Id : E) return B;
- function Has_Anon_Block_Suffix (Id : E) return B;
- function Has_Atomic_Components (Id : E) return B;
- function Has_Biased_Representation (Id : E) return B;
- function Has_Completion (Id : E) return B;
- function Has_Completion_In_Body (Id : E) return B;
- function Has_Complex_Representation (Id : E) return B;
- function Has_Component_Size_Clause (Id : E) return B;
- function Has_Constrained_Partial_View (Id : E) return B;
- function Has_Contiguous_Rep (Id : E) return B;
- function Has_Controlled_Component (Id : E) return B;
- function Has_Controlling_Result (Id : E) return B;
- function Has_Convention_Pragma (Id : E) return B;
- function Has_Delayed_Freeze (Id : E) return B;
- function Has_Discriminants (Id : E) return B;
- function Has_Enumeration_Rep_Clause (Id : E) return B;
- function Has_Exit (Id : E) return B;
- function Has_External_Tag_Rep_Clause (Id : E) return B;
- function Has_Fully_Qualified_Name (Id : E) return B;
- function Has_Gigi_Rep_Item (Id : E) return B;
- function Has_Homonym (Id : E) return B;
- function Has_Interrupt_Handler (Id : E) return B;
- function Has_Machine_Radix_Clause (Id : E) return B;
- function Has_Master_Entity (Id : E) return B;
- function Has_Missing_Return (Id : E) return B;
- function Has_Nested_Block_With_Handler (Id : E) return B;
- function Has_Forward_Instantiation (Id : E) return B;
- function Has_Non_Standard_Rep (Id : E) return B;
- function Has_Object_Size_Clause (Id : E) return B;
- function Has_Per_Object_Constraint (Id : E) return B;
- function Has_Persistent_BSS (Id : E) return B;
- function Has_Pragma_Controlled (Id : E) return B;
- function Has_Pragma_Elaborate_Body (Id : E) return B;
- function Has_Pragma_Inline (Id : E) return B;
- function Has_Pragma_Pack (Id : E) return B;
- function Has_Pragma_Pure (Id : E) return B;
- function Has_Pragma_Pure_Function (Id : E) return B;
- function Has_Pragma_Unreferenced (Id : E) return B;
- function Has_Primitive_Operations (Id : E) return B;
- function Has_Qualified_Name (Id : E) return B;
- function Has_Record_Rep_Clause (Id : E) return B;
- function Has_Recursive_Call (Id : E) return B;
- function Has_Size_Clause (Id : E) return B;
- function Has_Small_Clause (Id : E) return B;
- function Has_Specified_Layout (Id : E) return B;
- function Has_Specified_Stream_Input (Id : E) return B;
- function Has_Specified_Stream_Output (Id : E) return B;
- function Has_Specified_Stream_Read (Id : E) return B;
- function Has_Specified_Stream_Write (Id : E) return B;
- function Has_Static_Discriminants (Id : E) return B;
- function Has_Storage_Size_Clause (Id : E) return B;
- function Has_Stream_Size_Clause (Id : E) return B;
- function Has_Subprogram_Descriptor (Id : E) return B;
- function Has_Task (Id : E) return B;
- function Has_Unchecked_Union (Id : E) return B;
- function Has_Unknown_Discriminants (Id : E) return B;
- function Has_Volatile_Components (Id : E) return B;
- function Has_Xref_Entry (Id : E) return B;
- function Hiding_Loop_Variable (Id : E) return E;
- function Homonym (Id : E) return E;
- function In_Package_Body (Id : E) return B;
- function In_Private_Part (Id : E) return B;
- function In_Use (Id : E) return B;
- function Inner_Instances (Id : E) return L;
- function Interface_Name (Id : E) return N;
- function Is_AST_Entry (Id : E) return B;
- function Is_Abstract (Id : E) return B;
- function Is_Local_Anonymous_Access (Id : E) return B;
- function Is_Access_Constant (Id : E) return B;
- function Is_Ada_2005_Only (Id : E) return B;
- function Is_Aliased (Id : E) return B;
- function Is_Asynchronous (Id : E) return B;
- function Is_Atomic (Id : E) return B;
- function Is_Bit_Packed_Array (Id : E) return B;
- function Is_CPP_Class (Id : E) return B;
- function Is_Called (Id : E) return B;
- function Is_Character_Type (Id : E) return B;
- function Is_Child_Unit (Id : E) return B;
- function Is_Class_Wide_Equivalent_Type (Id : E) return B;
- function Is_Compilation_Unit (Id : E) return B;
- function Is_Completely_Hidden (Id : E) return B;
- function Is_Constr_Subt_For_UN_Aliased (Id : E) return B;
- function Is_Constr_Subt_For_U_Nominal (Id : E) return B;
- function Is_Constrained (Id : E) return B;
- function Is_Constructor (Id : E) return B;
- function Is_Controlled (Id : E) return B;
- function Is_Controlling_Formal (Id : E) return B;
- function Is_Discrim_SO_Function (Id : E) return B;
- function Is_Dispatching_Operation (Id : E) return B;
- function Is_Eliminated (Id : E) return B;
- function Is_Entry_Formal (Id : E) return B;
- function Is_Exported (Id : E) return B;
- function Is_First_Subtype (Id : E) return B;
- function Is_For_Access_Subtype (Id : E) return B;
- function Is_Frozen (Id : E) return B;
- function Is_Generic_Instance (Id : E) return B;
- function Is_Hidden (Id : E) return B;
- function Is_Hidden_Open_Scope (Id : E) return B;
- function Is_Immediately_Visible (Id : E) return B;
- function Is_Imported (Id : E) return B;
- function Is_Inlined (Id : E) return B;
- function Is_Interface (Id : E) return B;
- function Is_Instantiated (Id : E) return B;
- function Is_Internal (Id : E) return B;
- function Is_Interrupt_Handler (Id : E) return B;
- function Is_Intrinsic_Subprogram (Id : E) return B;
- function Is_Itype (Id : E) return B;
- function Is_Known_Non_Null (Id : E) return B;
- function Is_Known_Null (Id : E) return B;
- function Is_Known_Valid (Id : E) return B;
- function Is_Limited_Composite (Id : E) return B;
- function Is_Limited_Interface (Id : E) return B;
- function Is_Machine_Code_Subprogram (Id : E) return B;
- function Is_Non_Static_Subtype (Id : E) return B;
- function Is_Null_Init_Proc (Id : E) return B;
- function Is_Obsolescent (Id : E) return B;
- function Is_Optional_Parameter (Id : E) return B;
- function Is_Package_Body_Entity (Id : E) return B;
- function Is_Packed (Id : E) return B;
- function Is_Packed_Array_Type (Id : E) return B;
- function Is_Potentially_Use_Visible (Id : E) return B;
- function Is_Preelaborated (Id : E) return B;
- function Is_Primitive_Wrapper (Id : E) return B;
- function Is_Private_Composite (Id : E) return B;
- function Is_Private_Descendant (Id : E) return B;
- function Is_Protected_Interface (Id : E) return B;
- function Is_Public (Id : E) return B;
- function Is_Pure (Id : E) return B;
- function Is_Pure_Unit_Access_Type (Id : E) return B;
- function Is_Remote_Call_Interface (Id : E) return B;
- function Is_Remote_Types (Id : E) return B;
- function Is_Renaming_Of_Object (Id : E) return B;
- function Is_Return_Object (Id : E) return B;
- function Is_Shared_Passive (Id : E) return B;
- function Is_Statically_Allocated (Id : E) return B;
- function Is_Synchronized_Interface (Id : E) return B;
- function Is_Tag (Id : E) return B;
- function Is_Tagged_Type (Id : E) return B;
- function Is_Task_Interface (Id : E) return B;
- function Is_Thread_Body (Id : E) return B;
- function Is_True_Constant (Id : E) return B;
- function Is_Unchecked_Union (Id : E) return B;
- function Is_Unsigned_Type (Id : E) return B;
- function Is_VMS_Exception (Id : E) return B;
- function Is_Valued_Procedure (Id : E) return B;
- function Is_Visible_Child_Unit (Id : E) return B;
- function Is_Visible_Formal (Id : E) return B;
- function Is_Volatile (Id : E) return B;
- function Itype_Printed (Id : E) return B;
- function Kill_Elaboration_Checks (Id : E) return B;
- function Kill_Range_Checks (Id : E) return B;
- function Kill_Tag_Checks (Id : E) return B;
- function Known_To_Have_Preelab_Init (Id : E) return B;
- function Last_Assignment (Id : E) return N;
- function Last_Entity (Id : E) return E;
- function Limited_View (Id : E) return E;
- function Lit_Indexes (Id : E) return E;
- function Lit_Strings (Id : E) return E;
- function Low_Bound_Known (Id : E) return B;
- function Machine_Radix_10 (Id : E) return B;
- function Master_Id (Id : E) return E;
- function Materialize_Entity (Id : E) return B;
- function Mechanism (Id : E) return M;
- function Modulus (Id : E) return U;
- function Must_Be_On_Byte_Boundary (Id : E) return B;
- function Must_Have_Preelab_Init (Id : E) return B;
- function Needs_Debug_Info (Id : E) return B;
- function Needs_No_Actuals (Id : E) return B;
- function Never_Set_In_Source (Id : E) return B;
- function Next_Inlined_Subprogram (Id : E) return E;
- function No_Pool_Assigned (Id : E) return B;
- function No_Return (Id : E) return B;
- function No_Strict_Aliasing (Id : E) return B;
- function Non_Binary_Modulus (Id : E) return B;
- function Non_Limited_View (Id : E) return E;
- function Nonzero_Is_True (Id : E) return B;
- function Normalized_First_Bit (Id : E) return U;
- function Normalized_Position (Id : E) return U;
- function Normalized_Position_Max (Id : E) return U;
- function Object_Ref (Id : E) return E;
- function Obsolescent_Warning (Id : E) return N;
- function Original_Access_Type (Id : E) return E;
- function Original_Array_Type (Id : E) return E;
- function Original_Record_Component (Id : E) return E;
- function Overridden_Operation (Id : E) return E;
- function Package_Instantiation (Id : E) return N;
- function Packed_Array_Type (Id : E) return E;
- function Parent_Subtype (Id : E) return E;
- function Primitive_Operations (Id : E) return L;
- function Prival (Id : E) return E;
- function Privals_Chain (Id : E) return L;
- function Private_Dependents (Id : E) return L;
- function Private_View (Id : E) return N;
- function Protected_Body_Subprogram (Id : E) return E;
- function Protected_Formal (Id : E) return E;
- function Protected_Operation (Id : E) return E;
- function RM_Size (Id : E) return U;
- function Reachable (Id : E) return B;
- function Referenced (Id : E) return B;
- function Referenced_As_LHS (Id : E) return B;
- function Referenced_Object (Id : E) return N;
- function Register_Exception_Call (Id : E) return N;
- function Related_Array_Object (Id : E) return E;
- function Related_Instance (Id : E) return E;
- function Renamed_Entity (Id : E) return N;
- function Renamed_Object (Id : E) return N;
- function Renaming_Map (Id : E) return U;
- function Return_Present (Id : E) return B;
- function Return_Applies_To (Id : E) return N;
- function Returns_By_Ref (Id : E) return B;
- function Reverse_Bit_Order (Id : E) return B;
- function Scalar_Range (Id : E) return N;
- function Scale_Value (Id : E) return U;
- function Scope_Depth_Value (Id : E) return U;
- function Sec_Stack_Needed_For_Return (Id : E) return B;
- function Shadow_Entities (Id : E) return S;
- function Shared_Var_Assign_Proc (Id : E) return E;
- function Shared_Var_Read_Proc (Id : E) return E;
- function Size_Check_Code (Id : E) return N;
- function Size_Known_At_Compile_Time (Id : E) return B;
- function Size_Depends_On_Discriminant (Id : E) return B;
- function Small_Value (Id : E) return R;
- function Spec_Entity (Id : E) return E;
- function Storage_Size_Variable (Id : E) return E;
- function Stored_Constraint (Id : E) return L;
- function Strict_Alignment (Id : E) return B;
- function String_Literal_Length (Id : E) return U;
- function String_Literal_Low_Bound (Id : E) return N;
- function Suppress_Elaboration_Warnings (Id : E) return B;
- function Suppress_Init_Proc (Id : E) return B;
- function Suppress_Style_Checks (Id : E) return B;
- function Task_Body_Procedure (Id : E) return N;
- function Treat_As_Volatile (Id : E) return B;
- function Underlying_Full_View (Id : E) return E;
- function Unset_Reference (Id : E) return N;
- function Uses_Sec_Stack (Id : E) return B;
- function Vax_Float (Id : E) return B;
- function Warnings_Off (Id : E) return B;
- function Was_Hidden (Id : E) return B;
- function Wrapped_Entity (Id : E) return E;
+ function Abstract_Interfaces (Id : E) return L;
+ function Accept_Address (Id : E) return L;
+ function Access_Disp_Table (Id : E) return L;
+ function Actual_Subtype (Id : E) return E;
+ function Address_Taken (Id : E) return B;
+ function Alias (Id : E) return E;
+ function Abstract_Interface_Alias (Id : E) return E;
+ function Alignment (Id : E) return U;
+ function Associated_Final_Chain (Id : E) return E;
+ function Associated_Formal_Package (Id : E) return E;
+ function Associated_Node_For_Itype (Id : E) return N;
+ function Associated_Storage_Pool (Id : E) return E;
+ function Barrier_Function (Id : E) return N;
+ function Block_Node (Id : E) return N;
+ function Body_Entity (Id : E) return E;
+ function Body_Needed_For_SAL (Id : E) return B;
+ function CR_Discriminant (Id : E) return E;
+ function C_Pass_By_Copy (Id : E) return B;
+ function Can_Never_Be_Null (Id : E) return B;
+ function Checks_May_Be_Suppressed (Id : E) return B;
+ function Class_Wide_Type (Id : E) return E;
+ function Cloned_Subtype (Id : E) return E;
+ function Component_Alignment (Id : E) return C;
+ function Component_Clause (Id : E) return N;
+ function Component_Bit_Offset (Id : E) return U;
+ function Component_Size (Id : E) return U;
+ function Component_Type (Id : E) return E;
+ function Corresponding_Concurrent_Type (Id : E) return E;
+ function Corresponding_Discriminant (Id : E) return E;
+ function Corresponding_Equality (Id : E) return E;
+ function Corresponding_Record_Type (Id : E) return E;
+ function Corresponding_Remote_Type (Id : E) return E;
+ function Current_Use_Clause (Id : E) return E;
+ function Current_Value (Id : E) return N;
+ function Debug_Info_Off (Id : E) return B;
+ function Debug_Renaming_Link (Id : E) return E;
+ function DTC_Entity (Id : E) return E;
+ function DT_Entry_Count (Id : E) return U;
+ function DT_Offset_To_Top_Func (Id : E) return E;
+ function DT_Position (Id : E) return U;
+ function Default_Expr_Function (Id : E) return E;
+ function Default_Expressions_Processed (Id : E) return B;
+ function Default_Value (Id : E) return N;
+ function Delay_Cleanups (Id : E) return B;
+ function Delay_Subprogram_Descriptors (Id : E) return B;
+ function Delta_Value (Id : E) return R;
+ function Dependent_Instances (Id : E) return L;
+ function Depends_On_Private (Id : E) return B;
+ function Digits_Value (Id : E) return U;
+ function Directly_Designated_Type (Id : E) return E;
+ function Discard_Names (Id : E) return B;
+ function Discriminal (Id : E) return E;
+ function Discriminal_Link (Id : E) return E;
+ function Discriminant_Checking_Func (Id : E) return E;
+ function Discriminant_Constraint (Id : E) return L;
+ function Discriminant_Default_Value (Id : E) return N;
+ function Discriminant_Number (Id : E) return U;
+ function Elaborate_Body_Desirable (Id : E) return B;
+ function Elaboration_Entity (Id : E) return E;
+ function Elaboration_Entity_Required (Id : E) return B;
+ function Enclosing_Scope (Id : E) return E;
+ function Entry_Accepted (Id : E) return B;
+ function Entry_Bodies_Array (Id : E) return E;
+ function Entry_Cancel_Parameter (Id : E) return E;
+ function Entry_Component (Id : E) return E;
+ function Entry_Formal (Id : E) return E;
+ function Entry_Index_Constant (Id : E) return E;
+ function Entry_Index_Type (Id : E) return E;
+ function Entry_Parameters_Type (Id : E) return E;
+ function Enum_Pos_To_Rep (Id : E) return E;
+ function Enumeration_Pos (Id : E) return U;
+ function Enumeration_Rep (Id : E) return U;
+ function Enumeration_Rep_Expr (Id : E) return N;
+ function Equivalent_Type (Id : E) return E;
+ function Esize (Id : E) return U;
+ function Exception_Code (Id : E) return U;
+ function Extra_Accessibility (Id : E) return E;
+ function Extra_Constrained (Id : E) return E;
+ function Extra_Formal (Id : E) return E;
+ function Extra_Formals (Id : E) return E;
+ function Finalization_Chain_Entity (Id : E) return E;
+ function Finalize_Storage_Only (Id : E) return B;
+ function First_Entity (Id : E) return E;
+ function First_Index (Id : E) return N;
+ function First_Literal (Id : E) return E;
+ function First_Optional_Parameter (Id : E) return E;
+ function First_Private_Entity (Id : E) return E;
+ function First_Rep_Item (Id : E) return N;
+ function Freeze_Node (Id : E) return N;
+ function From_With_Type (Id : E) return B;
+ function Full_View (Id : E) return E;
+ function Function_Returns_With_DSP (Id : E) return B;
+ function Generic_Homonym (Id : E) return E;
+ function Generic_Renamings (Id : E) return L;
+ function Handler_Records (Id : E) return S;
+ function Has_Aliased_Components (Id : E) return B;
+ function Has_Alignment_Clause (Id : E) return B;
+ function Has_All_Calls_Remote (Id : E) return B;
+ function Has_Anon_Block_Suffix (Id : E) return B;
+ function Has_Atomic_Components (Id : E) return B;
+ function Has_Biased_Representation (Id : E) return B;
+ function Has_Completion (Id : E) return B;
+ function Has_Completion_In_Body (Id : E) return B;
+ function Has_Complex_Representation (Id : E) return B;
+ function Has_Component_Size_Clause (Id : E) return B;
+ function Has_Constrained_Partial_View (Id : E) return B;
+ function Has_Contiguous_Rep (Id : E) return B;
+ function Has_Controlled_Component (Id : E) return B;
+ function Has_Controlling_Result (Id : E) return B;
+ function Has_Convention_Pragma (Id : E) return B;
+ function Has_Delayed_Freeze (Id : E) return B;
+ function Has_Discriminants (Id : E) return B;
+ function Has_Enumeration_Rep_Clause (Id : E) return B;
+ function Has_Exit (Id : E) return B;
+ function Has_External_Tag_Rep_Clause (Id : E) return B;
+ function Has_Fully_Qualified_Name (Id : E) return B;
+ function Has_Gigi_Rep_Item (Id : E) return B;
+ function Has_Homonym (Id : E) return B;
+ function Has_Interrupt_Handler (Id : E) return B;
+ function Has_Machine_Radix_Clause (Id : E) return B;
+ function Has_Master_Entity (Id : E) return B;
+ function Has_Missing_Return (Id : E) return B;
+ function Has_Nested_Block_With_Handler (Id : E) return B;
+ function Has_Forward_Instantiation (Id : E) return B;
+ function Has_Non_Standard_Rep (Id : E) return B;
+ function Has_Object_Size_Clause (Id : E) return B;
+ function Has_Per_Object_Constraint (Id : E) return B;
+ function Has_Persistent_BSS (Id : E) return B;
+ function Has_Pragma_Controlled (Id : E) return B;
+ function Has_Pragma_Elaborate_Body (Id : E) return B;
+ function Has_Pragma_Inline (Id : E) return B;
+ function Has_Pragma_Pack (Id : E) return B;
+ function Has_Pragma_Pure (Id : E) return B;
+ function Has_Pragma_Pure_Function (Id : E) return B;
+ function Has_Pragma_Unreferenced (Id : E) return B;
+ function Has_Pragma_Unreferenced_Objects (Id : E) return B;
+ function Has_Primitive_Operations (Id : E) return B;
+ function Has_Qualified_Name (Id : E) return B;
+ function Has_RACW (Id : E) return B;
+ function Has_Record_Rep_Clause (Id : E) return B;
+ function Has_Recursive_Call (Id : E) return B;
+ function Has_Size_Clause (Id : E) return B;
+ function Has_Small_Clause (Id : E) return B;
+ function Has_Specified_Layout (Id : E) return B;
+ function Has_Specified_Stream_Input (Id : E) return B;
+ function Has_Specified_Stream_Output (Id : E) return B;
+ function Has_Specified_Stream_Read (Id : E) return B;
+ function Has_Specified_Stream_Write (Id : E) return B;
+ function Has_Static_Discriminants (Id : E) return B;
+ function Has_Storage_Size_Clause (Id : E) return B;
+ function Has_Stream_Size_Clause (Id : E) return B;
+ function Has_Subprogram_Descriptor (Id : E) return B;
+ function Has_Task (Id : E) return B;
+ function Has_Unchecked_Union (Id : E) return B;
+ function Has_Unknown_Discriminants (Id : E) return B;
+ function Has_Volatile_Components (Id : E) return B;
+ function Has_Xref_Entry (Id : E) return B;
+ function Hiding_Loop_Variable (Id : E) return E;
+ function Homonym (Id : E) return E;
+ function In_Package_Body (Id : E) return B;
+ function In_Private_Part (Id : E) return B;
+ function In_Use (Id : E) return B;
+ function Inner_Instances (Id : E) return L;
+ function Interface_Name (Id : E) return N;
+ function Is_AST_Entry (Id : E) return B;
+ function Is_Abstract_Subprogram (Id : E) return B;
+ function Is_Abstract_Type (Id : E) return B;
+ function Is_Local_Anonymous_Access (Id : E) return B;
+ function Is_Access_Constant (Id : E) return B;
+ function Is_Ada_2005_Only (Id : E) return B;
+ function Is_Aliased (Id : E) return B;
+ function Is_Asynchronous (Id : E) return B;
+ function Is_Atomic (Id : E) return B;
+ function Is_Bit_Packed_Array (Id : E) return B;
+ function Is_CPP_Class (Id : E) return B;
+ function Is_Called (Id : E) return B;
+ function Is_Character_Type (Id : E) return B;
+ function Is_Child_Unit (Id : E) return B;
+ function Is_Class_Wide_Equivalent_Type (Id : E) return B;
+ function Is_Compilation_Unit (Id : E) return B;
+ function Is_Completely_Hidden (Id : E) return B;
+ function Is_Constr_Subt_For_UN_Aliased (Id : E) return B;
+ function Is_Constr_Subt_For_U_Nominal (Id : E) return B;
+ function Is_Constrained (Id : E) return B;
+ function Is_Constructor (Id : E) return B;
+ function Is_Controlled (Id : E) return B;
+ function Is_Controlling_Formal (Id : E) return B;
+ function Is_Discrim_SO_Function (Id : E) return B;
+ function Is_Dispatching_Operation (Id : E) return B;
+ function Is_Eliminated (Id : E) return B;
+ function Is_Entry_Formal (Id : E) return B;
+ function Is_Exported (Id : E) return B;
+ function Is_First_Subtype (Id : E) return B;
+ function Is_For_Access_Subtype (Id : E) return B;
+ function Is_Frozen (Id : E) return B;
+ function Is_Generic_Instance (Id : E) return B;
+ function Is_Hidden (Id : E) return B;
+ function Is_Hidden_Open_Scope (Id : E) return B;
+ function Is_Immediately_Visible (Id : E) return B;
+ function Is_Imported (Id : E) return B;
+ function Is_Inlined (Id : E) return B;
+ function Is_Interface (Id : E) return B;
+ function Is_Instantiated (Id : E) return B;
+ function Is_Internal (Id : E) return B;
+ function Is_Interrupt_Handler (Id : E) return B;
+ function Is_Intrinsic_Subprogram (Id : E) return B;
+ function Is_Itype (Id : E) return B;
+ function Is_Known_Non_Null (Id : E) return B;
+ function Is_Known_Null (Id : E) return B;
+ function Is_Known_Valid (Id : E) return B;
+ function Is_Limited_Composite (Id : E) return B;
+ function Is_Limited_Interface (Id : E) return B;
+ function Is_Machine_Code_Subprogram (Id : E) return B;
+ function Is_Non_Static_Subtype (Id : E) return B;
+ function Is_Null_Init_Proc (Id : E) return B;
+ function Is_Obsolescent (Id : E) return B;
+ function Is_Optional_Parameter (Id : E) return B;
+ function Is_Package_Body_Entity (Id : E) return B;
+ function Is_Packed (Id : E) return B;
+ function Is_Packed_Array_Type (Id : E) return B;
+ function Is_Potentially_Use_Visible (Id : E) return B;
+ function Is_Preelaborated (Id : E) return B;
+ function Is_Primitive_Wrapper (Id : E) return B;
+ function Is_Private_Composite (Id : E) return B;
+ function Is_Private_Descendant (Id : E) return B;
+ function Is_Protected_Interface (Id : E) return B;
+ function Is_Public (Id : E) return B;
+ function Is_Pure (Id : E) return B;
+ function Is_Pure_Unit_Access_Type (Id : E) return B;
+ function Is_Remote_Call_Interface (Id : E) return B;
+ function Is_Remote_Types (Id : E) return B;
+ function Is_Renaming_Of_Object (Id : E) return B;
+ function Is_Return_Object (Id : E) return B;
+ function Is_Shared_Passive (Id : E) return B;
+ function Is_Statically_Allocated (Id : E) return B;
+ function Is_Synchronized_Interface (Id : E) return B;
+ function Is_Tag (Id : E) return B;
+ function Is_Tagged_Type (Id : E) return B;
+ function Is_Task_Interface (Id : E) return B;
+ function Is_Thread_Body (Id : E) return B;
+ function Is_True_Constant (Id : E) return B;
+ function Is_Unchecked_Union (Id : E) return B;
+ function Is_Unsigned_Type (Id : E) return B;
+ function Is_VMS_Exception (Id : E) return B;
+ function Is_Valued_Procedure (Id : E) return B;
+ function Is_Visible_Child_Unit (Id : E) return B;
+ function Is_Visible_Formal (Id : E) return B;
+ function Is_Volatile (Id : E) return B;
+ function Itype_Printed (Id : E) return B;
+ function Kill_Elaboration_Checks (Id : E) return B;
+ function Kill_Range_Checks (Id : E) return B;
+ function Kill_Tag_Checks (Id : E) return B;
+ function Known_To_Have_Preelab_Init (Id : E) return B;
+ function Last_Assignment (Id : E) return N;
+ function Last_Entity (Id : E) return E;
+ function Limited_View (Id : E) return E;
+ function Lit_Indexes (Id : E) return E;
+ function Lit_Strings (Id : E) return E;
+ function Low_Bound_Known (Id : E) return B;
+ function Machine_Radix_10 (Id : E) return B;
+ function Master_Id (Id : E) return E;
+ function Materialize_Entity (Id : E) return B;
+ function Mechanism (Id : E) return M;
+ function Modulus (Id : E) return U;
+ function Must_Be_On_Byte_Boundary (Id : E) return B;
+ function Must_Have_Preelab_Init (Id : E) return B;
+ function Needs_Debug_Info (Id : E) return B;
+ function Needs_No_Actuals (Id : E) return B;
+ function Never_Set_In_Source (Id : E) return B;
+ function Next_Inlined_Subprogram (Id : E) return E;
+ function No_Pool_Assigned (Id : E) return B;
+ function No_Return (Id : E) return B;
+ function No_Strict_Aliasing (Id : E) return B;
+ function Non_Binary_Modulus (Id : E) return B;
+ function Non_Limited_View (Id : E) return E;
+ function Nonzero_Is_True (Id : E) return B;
+ function Normalized_First_Bit (Id : E) return U;
+ function Normalized_Position (Id : E) return U;
+ function Normalized_Position_Max (Id : E) return U;
+ function Object_Ref (Id : E) return E;
+ function Obsolescent_Warning (Id : E) return N;
+ function Original_Access_Type (Id : E) return E;
+ function Original_Array_Type (Id : E) return E;
+ function Original_Record_Component (Id : E) return E;
+ function Overridden_Operation (Id : E) return E;
+ function Package_Instantiation (Id : E) return N;
+ function Packed_Array_Type (Id : E) return E;
+ function Parent_Subtype (Id : E) return E;
+ function Primitive_Operations (Id : E) return L;
+ function Prival (Id : E) return E;
+ function Privals_Chain (Id : E) return L;
+ function Private_Dependents (Id : E) return L;
+ function Private_View (Id : E) return N;
+ function Protected_Body_Subprogram (Id : E) return E;
+ function Protected_Formal (Id : E) return E;
+ function Protected_Operation (Id : E) return E;
+ function RM_Size (Id : E) return U;
+ function Reachable (Id : E) return B;
+ function Referenced (Id : E) return B;
+ function Referenced_As_LHS (Id : E) return B;
+ function Referenced_Object (Id : E) return N;
+ function Register_Exception_Call (Id : E) return N;
+ function Related_Array_Object (Id : E) return E;
+ function Related_Instance (Id : E) return E;
+ function Renamed_Entity (Id : E) return N;
+ function Renamed_Object (Id : E) return N;
+ function Renaming_Map (Id : E) return U;
+ function Requires_Overriding (Id : E) return B;
+ function Return_Present (Id : E) return B;
+ function Return_Applies_To (Id : E) return N;
+ function Returns_By_Ref (Id : E) return B;
+ function Reverse_Bit_Order (Id : E) return B;
+ function Scalar_Range (Id : E) return N;
+ function Scale_Value (Id : E) return U;
+ function Scope_Depth_Value (Id : E) return U;
+ function Sec_Stack_Needed_For_Return (Id : E) return B;
+ function Shadow_Entities (Id : E) return S;
+ function Shared_Var_Assign_Proc (Id : E) return E;
+ function Shared_Var_Read_Proc (Id : E) return E;
+ function Size_Check_Code (Id : E) return N;
+ function Size_Known_At_Compile_Time (Id : E) return B;
+ function Size_Depends_On_Discriminant (Id : E) return B;
+ function Small_Value (Id : E) return R;
+ function Spec_Entity (Id : E) return E;
+ function Storage_Size_Variable (Id : E) return E;
+ function Stored_Constraint (Id : E) return L;
+ function Strict_Alignment (Id : E) return B;
+ function String_Literal_Length (Id : E) return U;
+ function String_Literal_Low_Bound (Id : E) return N;
+ function Suppress_Elaboration_Warnings (Id : E) return B;
+ function Suppress_Init_Proc (Id : E) return B;
+ function Suppress_Style_Checks (Id : E) return B;
+ function Task_Body_Procedure (Id : E) return N;
+ function Treat_As_Volatile (Id : E) return B;
+ function Underlying_Full_View (Id : E) return E;
+ function Unset_Reference (Id : E) return N;
+ function Uses_Sec_Stack (Id : E) return B;
+ function Vax_Float (Id : E) return B;
+ function Warnings_Off (Id : E) return B;
+ function Was_Hidden (Id : E) return B;
+ function Wrapped_Entity (Id : E) return E;
-------------------------------
-- Classification Attributes --
-- In some cases, the test is of an entity attribute (e.g. in the case of
-- Is_Generic_Type where the Ekind does not provide the needed information)
- function Is_Access_Type (Id : E) return B;
- function Is_Array_Type (Id : E) return B;
- function Is_Class_Wide_Type (Id : E) return B;
- function Is_Composite_Type (Id : E) return B;
- function Is_Concurrent_Body (Id : E) return B;
- function Is_Concurrent_Record_Type (Id : E) return B;
- function Is_Concurrent_Type (Id : E) return B;
- function Is_Decimal_Fixed_Point_Type (Id : E) return B;
- function Is_Digits_Type (Id : E) return B;
- function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B;
- function Is_Discrete_Type (Id : E) return B;
- function Is_Elementary_Type (Id : E) return B;
- function Is_Entry (Id : E) return B;
- function Is_Enumeration_Type (Id : E) return B;
- function Is_Fixed_Point_Type (Id : E) return B;
- function Is_Floating_Point_Type (Id : E) return B;
- function Is_Formal (Id : E) return B;
- function Is_Formal_Object (Id : E) return B;
- function Is_Formal_Subprogram (Id : E) return B;
- function Is_Generic_Actual_Type (Id : E) return B;
- function Is_Generic_Unit (Id : E) return B;
- function Is_Generic_Type (Id : E) return B;
- function Is_Generic_Subprogram (Id : E) return B;
- function Is_Incomplete_Or_Private_Type (Id : E) return B;
- function Is_Incomplete_Type (Id : E) return B;
- function Is_Integer_Type (Id : E) return B;
- function Is_Limited_Record (Id : E) return B;
- function Is_Modular_Integer_Type (Id : E) return B;
- function Is_Named_Number (Id : E) return B;
- function Is_Numeric_Type (Id : E) return B;
- function Is_Object (Id : E) return B;
- function Is_Ordinary_Fixed_Point_Type (Id : E) return B;
- function Is_Overloadable (Id : E) return B;
- function Is_Overriding_Operation (Id : E) return B;
- function Is_Private_Type (Id : E) return B;
- function Is_Protected_Type (Id : E) return B;
- function Is_Real_Type (Id : E) return B;
- function Is_Record_Type (Id : E) return B;
- function Is_Scalar_Type (Id : E) return B;
- function Is_Signed_Integer_Type (Id : E) return B;
- function Is_Subprogram (Id : E) return B;
- function Is_Task_Type (Id : E) return B;
- function Is_Type (Id : E) return B;
+ function Is_Access_Type (Id : E) return B;
+ function Is_Access_Protected_Subprogram_Type (Id : E) return B;
+ function Is_Array_Type (Id : E) return B;
+ function Is_Class_Wide_Type (Id : E) return B;
+ function Is_Composite_Type (Id : E) return B;
+ function Is_Concurrent_Body (Id : E) return B;
+ function Is_Concurrent_Record_Type (Id : E) return B;
+ function Is_Concurrent_Type (Id : E) return B;
+ function Is_Decimal_Fixed_Point_Type (Id : E) return B;
+ function Is_Digits_Type (Id : E) return B;
+ function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B;
+ function Is_Discrete_Type (Id : E) return B;
+ function Is_Elementary_Type (Id : E) return B;
+ function Is_Entry (Id : E) return B;
+ function Is_Enumeration_Type (Id : E) return B;
+ function Is_Fixed_Point_Type (Id : E) return B;
+ function Is_Floating_Point_Type (Id : E) return B;
+ function Is_Formal (Id : E) return B;
+ function Is_Formal_Object (Id : E) return B;
+ function Is_Formal_Subprogram (Id : E) return B;
+ function Is_Generic_Actual_Type (Id : E) return B;
+ function Is_Generic_Unit (Id : E) return B;
+ function Is_Generic_Type (Id : E) return B;
+ function Is_Generic_Subprogram (Id : E) return B;
+ function Is_Incomplete_Or_Private_Type (Id : E) return B;
+ function Is_Incomplete_Type (Id : E) return B;
+ function Is_Integer_Type (Id : E) return B;
+ function Is_Limited_Record (Id : E) return B;
+ function Is_Modular_Integer_Type (Id : E) return B;
+ function Is_Named_Number (Id : E) return B;
+ function Is_Numeric_Type (Id : E) return B;
+ function Is_Object (Id : E) return B;
+ function Is_Ordinary_Fixed_Point_Type (Id : E) return B;
+ function Is_Overloadable (Id : E) return B;
+ function Is_Overriding_Operation (Id : E) return B;
+ function Is_Private_Type (Id : E) return B;
+ function Is_Protected_Type (Id : E) return B;
+ function Is_Real_Type (Id : E) return B;
+ function Is_Record_Type (Id : E) return B;
+ function Is_Scalar_Type (Id : E) return B;
+ function Is_Signed_Integer_Type (Id : E) return B;
+ function Is_Subprogram (Id : E) return B;
+ function Is_Task_Type (Id : E) return B;
+ function Is_Type (Id : E) return B;
-------------------------------------
-- Synthesized Attribute Functions --
-- The functions in this section synthesize attributes from the tree,
-- so they do not correspond to defined fields in the entity itself.
- function Address_Clause (Id : E) return N;
- function Alignment_Clause (Id : E) return N;
- function Ancestor_Subtype (Id : E) return E;
- function Base_Type (Id : E) return E;
- function Constant_Value (Id : E) return N;
- function Declaration_Node (Id : E) return N;
- function Designated_Type (Id : E) return E;
- function Enclosing_Dynamic_Scope (Id : E) return E;
- function First_Component (Id : E) return E;
- function First_Discriminant (Id : E) return E;
- function First_Formal (Id : E) return E;
- function First_Formal_With_Extras (Id : E) return E;
- function First_Stored_Discriminant (Id : E) return E;
- function First_Subtype (Id : E) return E;
- function Has_Attach_Handler (Id : E) return B;
- function Has_Entries (Id : E) return B;
- function Has_Foreign_Convention (Id : E) return B;
- function Has_Private_Ancestor (Id : E) return B;
- function Has_Private_Declaration (Id : E) return B;
- function Implementation_Base_Type (Id : E) return E;
- function Is_Always_Inlined (Id : E) return B;
- function Is_Boolean_Type (Id : E) return B;
- function Is_By_Copy_Type (Id : E) return B;
- function Is_By_Reference_Type (Id : E) return B;
- function Is_Derived_Type (Id : E) return B;
- function Is_Dynamic_Scope (Id : E) return B;
- function Is_Indefinite_Subtype (Id : E) return B;
- function Is_Limited_Type (Id : E) return B;
- function Is_Package_Or_Generic_Package (Id : E) return B;
- function Is_Protected_Private (Id : E) return B;
- function Is_Protected_Record_Type (Id : E) return B;
- function Is_Inherently_Limited_Type (Id : E) return B;
- function Is_String_Type (Id : E) return B;
- function Is_Task_Record_Type (Id : E) return B;
- function Is_Wrapper_Package (Id : E) return B;
- function Next_Component (Id : E) return E;
- function Next_Discriminant (Id : E) return E;
- function Next_Formal (Id : E) return E;
- function Next_Formal_With_Extras (Id : E) return E;
- function Next_Literal (Id : E) return E;
- function Next_Stored_Discriminant (Id : E) return E;
- function Number_Dimensions (Id : E) return Pos;
- function Number_Discriminants (Id : E) return Pos;
- function Number_Entries (Id : E) return Nat;
- function Number_Formals (Id : E) return Pos;
- function Parameter_Mode (Id : E) return Formal_Kind;
- function Root_Type (Id : E) return E;
- function Scope_Depth_Set (Id : E) return B;
- function Size_Clause (Id : E) return N;
- function Stream_Size_Clause (Id : E) return N;
- function First_Tag_Component (Id : E) return E;
- function Next_Tag_Component (Id : E) return E;
- function Type_High_Bound (Id : E) return N;
- function Type_Low_Bound (Id : E) return N;
- function Underlying_Type (Id : E) return E;
+ function Address_Clause (Id : E) return N;
+ function Alignment_Clause (Id : E) return N;
+ function Ancestor_Subtype (Id : E) return E;
+ function Base_Type (Id : E) return E;
+ function Constant_Value (Id : E) return N;
+ function Declaration_Node (Id : E) return N;
+ function Designated_Type (Id : E) return E;
+ function Enclosing_Dynamic_Scope (Id : E) return E;
+ function First_Component (Id : E) return E;
+ function First_Component_Or_Discriminant (Id : E) return E;
+ function First_Discriminant (Id : E) return E;
+ function First_Formal (Id : E) return E;
+ function First_Formal_With_Extras (Id : E) return E;
+ function First_Stored_Discriminant (Id : E) return E;
+ function First_Subtype (Id : E) return E;
+ function Has_Attach_Handler (Id : E) return B;
+ function Has_Entries (Id : E) return B;
+ function Has_Foreign_Convention (Id : E) return B;
+ function Has_Private_Ancestor (Id : E) return B;
+ function Has_Private_Declaration (Id : E) return B;
+ function Implementation_Base_Type (Id : E) return E;
+ function Is_Always_Inlined (Id : E) return B;
+ function Is_Boolean_Type (Id : E) return B;
+ function Is_By_Copy_Type (Id : E) return B;
+ function Is_By_Reference_Type (Id : E) return B;
+ function Is_Derived_Type (Id : E) return B;
+ function Is_Dynamic_Scope (Id : E) return B;
+ function Is_Indefinite_Subtype (Id : E) return B;
+ function Is_Limited_Type (Id : E) return B;
+ function Is_Package_Or_Generic_Package (Id : E) return B;
+ function Is_Protected_Private (Id : E) return B;
+ function Is_Protected_Record_Type (Id : E) return B;
+ function Is_Inherently_Limited_Type (Id : E) return B;
+ function Is_String_Type (Id : E) return B;
+ function Is_Task_Record_Type (Id : E) return B;
+ function Is_Wrapper_Package (Id : E) return B;
+ function Next_Component (Id : E) return E;
+ function Next_Component_Or_Discriminant (Id : E) return E;
+ function Next_Discriminant (Id : E) return E;
+ function Next_Formal (Id : E) return E;
+ function Next_Formal_With_Extras (Id : E) return E;
+ function Next_Literal (Id : E) return E;
+ function Next_Stored_Discriminant (Id : E) return E;
+ function Number_Dimensions (Id : E) return Pos;
+ function Number_Discriminants (Id : E) return Pos;
+ function Number_Entries (Id : E) return Nat;
+ function Number_Formals (Id : E) return Pos;
+ function Parameter_Mode (Id : E) return Formal_Kind;
+ function Root_Type (Id : E) return E;
+ function Scope_Depth_Set (Id : E) return B;
+ function Size_Clause (Id : E) return N;
+ function Stream_Size_Clause (Id : E) return N;
+ function First_Tag_Component (Id : E) return E;
+ function Next_Tag_Component (Id : E) return E;
+ function Type_High_Bound (Id : E) return N;
+ function Type_Low_Bound (Id : E) return N;
+ function Underlying_Type (Id : E) return E;
----------------------------------------------
-- Type Representation Attribute Predicates --
----------------------------------------------
- -- These predicates test the setting of the indicated attribute. If
- -- the value has been set, then Known is True, and Unknown is False.
- -- If no value is set, then Known is False and Unknown is True. The
- -- Known_Static predicate is true only if the value is set (Known)
- -- and is set to a compile time known value. Note that in the case
- -- of Alignment and Normalized_First_Bit, dynamic values are not
- -- possible, so we do not need a separate Known_Static calls in
- -- these cases. The not set (unknown values are as follows:
+ -- These predicates test the setting of the indicated attribute. If the
+ -- value has been set, then Known is True, and Unknown is False. If no
+ -- value is set, then Known is False and Unknown is True. The Known_Static
+ -- predicate is true only if the value is set (Known) and is set to a
+ -- compile time known value. Note that in the case of Alignment and
+ -- Normalized_First_Bit, dynamic values are not possible, so we do not
+ -- need a separate Known_Static calls in these cases. The not set (unknown
+ -- values are as follows:
-- Alignment Uint_0 or No_Uint
-- Component_Size Uint_0 or No_Uint
-- Attribute Set Procedures --
------------------------------
- procedure Set_Abstract_Interfaces (Id : E; V : L);
- procedure Set_Accept_Address (Id : E; V : L);
- procedure Set_Access_Disp_Table (Id : E; V : L);
- procedure Set_Actual_Subtype (Id : E; V : E);
- procedure Set_Address_Taken (Id : E; V : B := True);
- procedure Set_Alias (Id : E; V : E);
- procedure Set_Abstract_Interface_Alias (Id : E; V : E);
- procedure Set_Alignment (Id : E; V : U);
- procedure Set_Associated_Final_Chain (Id : E; V : E);
- procedure Set_Associated_Formal_Package (Id : E; V : E);
- procedure Set_Associated_Node_For_Itype (Id : E; V : N);
- procedure Set_Associated_Storage_Pool (Id : E; V : E);
- procedure Set_Barrier_Function (Id : E; V : N);
- procedure Set_Block_Node (Id : E; V : N);
- procedure Set_Body_Entity (Id : E; V : E);
- procedure Set_Body_Needed_For_SAL (Id : E; V : B := True);
- procedure Set_CR_Discriminant (Id : E; V : E);
- procedure Set_C_Pass_By_Copy (Id : E; V : B := True);
- procedure Set_Can_Never_Be_Null (Id : E; V : B := True);
- procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True);
- procedure Set_Class_Wide_Type (Id : E; V : E);
- procedure Set_Cloned_Subtype (Id : E; V : E);
- procedure Set_Component_Alignment (Id : E; V : C);
- procedure Set_Component_Bit_Offset (Id : E; V : U);
- procedure Set_Component_Clause (Id : E; V : N);
- procedure Set_Component_Size (Id : E; V : U);
- procedure Set_Component_Type (Id : E; V : E);
- procedure Set_Corresponding_Concurrent_Type (Id : E; V : E);
- procedure Set_Corresponding_Discriminant (Id : E; V : E);
- procedure Set_Corresponding_Equality (Id : E; V : E);
- procedure Set_Corresponding_Record_Type (Id : E; V : E);
- procedure Set_Corresponding_Remote_Type (Id : E; V : E);
- procedure Set_Current_Use_Clause (Id : E; V : E);
- procedure Set_Current_Value (Id : E; V : N);
- procedure Set_Debug_Info_Off (Id : E; V : B := True);
- procedure Set_Debug_Renaming_Link (Id : E; V : E);
- procedure Set_DTC_Entity (Id : E; V : E);
- procedure Set_DT_Entry_Count (Id : E; V : U);
- procedure Set_DT_Offset_To_Top_Func (Id : E; V : E);
- procedure Set_DT_Position (Id : E; V : U);
- procedure Set_Default_Expr_Function (Id : E; V : E);
- procedure Set_Default_Expressions_Processed (Id : E; V : B := True);
- procedure Set_Default_Value (Id : E; V : N);
- procedure Set_Delay_Cleanups (Id : E; V : B := True);
- procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True);
- procedure Set_Delta_Value (Id : E; V : R);
- procedure Set_Dependent_Instances (Id : E; V : L);
- procedure Set_Depends_On_Private (Id : E; V : B := True);
- procedure Set_Digits_Value (Id : E; V : U);
- procedure Set_Directly_Designated_Type (Id : E; V : E);
- procedure Set_Discard_Names (Id : E; V : B := True);
- procedure Set_Discriminal (Id : E; V : E);
- procedure Set_Discriminal_Link (Id : E; V : E);
- procedure Set_Discriminant_Checking_Func (Id : E; V : E);
- procedure Set_Discriminant_Constraint (Id : E; V : L);
- procedure Set_Discriminant_Default_Value (Id : E; V : N);
- procedure Set_Discriminant_Number (Id : E; V : U);
- procedure Set_Elaborate_Body_Desirable (Id : E; V : B := True);
- procedure Set_Elaboration_Entity (Id : E; V : E);
- procedure Set_Elaboration_Entity_Required (Id : E; V : B := True);
- procedure Set_Enclosing_Scope (Id : E; V : E);
- procedure Set_Entry_Accepted (Id : E; V : B := True);
- procedure Set_Entry_Bodies_Array (Id : E; V : E);
- procedure Set_Entry_Cancel_Parameter (Id : E; V : E);
- procedure Set_Entry_Component (Id : E; V : E);
- procedure Set_Entry_Formal (Id : E; V : E);
- procedure Set_Entry_Index_Constant (Id : E; V : E);
- procedure Set_Entry_Parameters_Type (Id : E; V : E);
- procedure Set_Enum_Pos_To_Rep (Id : E; V : E);
- procedure Set_Enumeration_Pos (Id : E; V : U);
- procedure Set_Enumeration_Rep (Id : E; V : U);
- procedure Set_Enumeration_Rep_Expr (Id : E; V : N);
- procedure Set_Equivalent_Type (Id : E; V : E);
- procedure Set_Esize (Id : E; V : U);
- procedure Set_Exception_Code (Id : E; V : U);
- procedure Set_Extra_Accessibility (Id : E; V : E);
- procedure Set_Extra_Constrained (Id : E; V : E);
- procedure Set_Extra_Formal (Id : E; V : E);
- procedure Set_Extra_Formals (Id : E; V : E);
- procedure Set_Finalization_Chain_Entity (Id : E; V : E);
- procedure Set_Finalize_Storage_Only (Id : E; V : B := True);
- procedure Set_First_Entity (Id : E; V : E);
- procedure Set_First_Index (Id : E; V : N);
- procedure Set_First_Literal (Id : E; V : E);
- procedure Set_First_Optional_Parameter (Id : E; V : E);
- procedure Set_First_Private_Entity (Id : E; V : E);
- procedure Set_First_Rep_Item (Id : E; V : N);
- procedure Set_Freeze_Node (Id : E; V : N);
- procedure Set_From_With_Type (Id : E; V : B := True);
- procedure Set_Full_View (Id : E; V : E);
- procedure Set_Function_Returns_With_DSP (Id : E; V : B := True);
- procedure Set_Generic_Homonym (Id : E; V : E);
- procedure Set_Generic_Renamings (Id : E; V : L);
- procedure Set_Handler_Records (Id : E; V : S);
- procedure Set_Has_Aliased_Components (Id : E; V : B := True);
- procedure Set_Has_Alignment_Clause (Id : E; V : B := True);
- procedure Set_Has_All_Calls_Remote (Id : E; V : B := True);
- procedure Set_Has_Anon_Block_Suffix (Id : E; V : B := True);
- procedure Set_Has_Atomic_Components (Id : E; V : B := True);
- procedure Set_Has_Biased_Representation (Id : E; V : B := True);
- procedure Set_Has_Completion (Id : E; V : B := True);
- procedure Set_Has_Completion_In_Body (Id : E; V : B := True);
- procedure Set_Has_Complex_Representation (Id : E; V : B := True);
- procedure Set_Has_Component_Size_Clause (Id : E; V : B := True);
- procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True);
- procedure Set_Has_Contiguous_Rep (Id : E; V : B := True);
- procedure Set_Has_Controlled_Component (Id : E; V : B := True);
- procedure Set_Has_Controlling_Result (Id : E; V : B := True);
- procedure Set_Has_Convention_Pragma (Id : E; V : B := True);
- procedure Set_Has_Delayed_Freeze (Id : E; V : B := True);
- procedure Set_Has_Discriminants (Id : E; V : B := True);
- procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True);
- procedure Set_Has_Exit (Id : E; V : B := True);
- procedure Set_Has_External_Tag_Rep_Clause (Id : E; V : B := True);
- procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True);
- procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True);
- procedure Set_Has_Homonym (Id : E; V : B := True);
- procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True);
- procedure Set_Has_Master_Entity (Id : E; V : B := True);
- 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_Forward_Instantiation (Id : E; V : B := True);
- procedure Set_Has_Non_Standard_Rep (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_Persistent_BSS (Id : E; V : B := True);
- procedure Set_Has_Pragma_Controlled (Id : E; V : B := True);
- procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True);
- procedure Set_Has_Pragma_Inline (Id : E; V : B := True);
- procedure Set_Has_Pragma_Pack (Id : E; V : B := True);
- procedure Set_Has_Pragma_Pure (Id : E; V : B := True);
- procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True);
- procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True);
- procedure Set_Has_Primitive_Operations (Id : E; V : B := True);
- procedure Set_Has_Private_Declaration (Id : E; V : B := True);
- procedure Set_Has_Qualified_Name (Id : E; V : B := True);
- procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True);
- procedure Set_Has_Recursive_Call (Id : E; V : B := True);
- procedure Set_Has_Size_Clause (Id : E; V : B := True);
- procedure Set_Has_Small_Clause (Id : E; V : B := True);
- procedure Set_Has_Specified_Layout (Id : E; V : B := True);
- procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True);
- procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True);
- procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True);
- procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True);
- procedure Set_Has_Static_Discriminants (Id : E; V : B := True);
- procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True);
- procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True);
- procedure Set_Has_Subprogram_Descriptor (Id : E; V : B := True);
- procedure Set_Has_Task (Id : E; V : B := True);
- procedure Set_Has_Unchecked_Union (Id : E; V : B := True);
- procedure Set_Has_Unknown_Discriminants (Id : E; V : B := True);
- procedure Set_Has_Volatile_Components (Id : E; V : B := True);
- procedure Set_Has_Xref_Entry (Id : E; V : B := True);
- procedure Set_Hiding_Loop_Variable (Id : E; V : E);
- procedure Set_Homonym (Id : E; V : E);
- procedure Set_In_Package_Body (Id : E; V : B := True);
- procedure Set_In_Private_Part (Id : E; V : B := True);
- procedure Set_In_Use (Id : E; V : B := True);
- procedure Set_Inner_Instances (Id : E; V : L);
- procedure Set_Interface_Name (Id : E; V : N);
- procedure Set_Is_AST_Entry (Id : E; V : B := True);
- procedure Set_Is_Abstract (Id : E; V : B := True);
- procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True);
- procedure Set_Is_Access_Constant (Id : E; V : B := True);
- procedure Set_Is_Ada_2005_Only (Id : E; V : B := True);
- procedure Set_Is_Aliased (Id : E; V : B := True);
- procedure Set_Is_Asynchronous (Id : E; V : B := True);
- procedure Set_Is_Atomic (Id : E; V : B := True);
- procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True);
- procedure Set_Is_CPP_Class (Id : E; V : B := True);
- procedure Set_Is_Called (Id : E; V : B := True);
- procedure Set_Is_Character_Type (Id : E; V : B := True);
- procedure Set_Is_Child_Unit (Id : E; V : B := True);
- procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True);
- procedure Set_Is_Compilation_Unit (Id : E; V : B := True);
- procedure Set_Is_Completely_Hidden (Id : E; V : B := True);
- procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True);
- procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True);
- procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True);
- procedure Set_Is_Constrained (Id : E; V : B := True);
- procedure Set_Is_Constructor (Id : E; V : B := True);
- procedure Set_Is_Controlled (Id : E; V : B := True);
- procedure Set_Is_Controlling_Formal (Id : E; V : B := True);
- procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True);
- procedure Set_Is_Dispatching_Operation (Id : E; V : B := True);
- procedure Set_Is_Eliminated (Id : E; V : B := True);
- procedure Set_Is_Entry_Formal (Id : E; V : B := True);
- procedure Set_Is_Exported (Id : E; V : B := True);
- procedure Set_Is_First_Subtype (Id : E; V : B := True);
- procedure Set_Is_For_Access_Subtype (Id : E; V : B := True);
- procedure Set_Is_Formal_Subprogram (Id : E; V : B := True);
- procedure Set_Is_Frozen (Id : E; V : B := True);
- procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True);
- procedure Set_Is_Generic_Instance (Id : E; V : B := True);
- procedure Set_Is_Generic_Type (Id : E; V : B := True);
- procedure Set_Is_Hidden (Id : E; V : B := True);
- procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True);
- procedure Set_Is_Immediately_Visible (Id : E; V : B := True);
- procedure Set_Is_Imported (Id : E; V : B := True);
- procedure Set_Is_Inlined (Id : E; V : B := True);
- procedure Set_Is_Interface (Id : E; V : B := True);
- procedure Set_Is_Instantiated (Id : E; V : B := True);
- procedure Set_Is_Internal (Id : E; V : B := True);
- procedure Set_Is_Interrupt_Handler (Id : E; V : B := True);
- procedure Set_Is_Intrinsic_Subprogram (Id : E; V : B := True);
- procedure Set_Is_Itype (Id : E; V : B := True);
- procedure Set_Is_Known_Non_Null (Id : E; V : B := True);
- procedure Set_Is_Known_Null (Id : E; V : B := True);
- procedure Set_Is_Known_Valid (Id : E; V : B := True);
- procedure Set_Is_Limited_Composite (Id : E; V : B := True);
- procedure Set_Is_Limited_Interface (Id : E; V : B := True);
- procedure Set_Is_Limited_Record (Id : E; V : B := True);
- procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True);
- procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True);
- procedure Set_Is_Null_Init_Proc (Id : E; V : B := True);
- procedure Set_Is_Obsolescent (Id : E; V : B := True);
- procedure Set_Is_Optional_Parameter (Id : E; V : B := True);
- procedure Set_Is_Overriding_Operation (Id : E; V : B := True);
- procedure Set_Is_Package_Body_Entity (Id : E; V : B := True);
- procedure Set_Is_Packed (Id : E; V : B := True);
- procedure Set_Is_Packed_Array_Type (Id : E; V : B := True);
- procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True);
- procedure Set_Is_Preelaborated (Id : E; V : B := True);
- procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True);
- procedure Set_Is_Private_Composite (Id : E; V : B := True);
- procedure Set_Is_Private_Descendant (Id : E; V : B := True);
- procedure Set_Is_Protected_Interface (Id : E; V : B := True);
- procedure Set_Is_Public (Id : E; V : B := True);
- procedure Set_Is_Pure (Id : E; V : B := True);
- procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True);
- procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True);
- procedure Set_Is_Remote_Types (Id : E; V : B := True);
- procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True);
- procedure Set_Is_Return_Object (Id : E; V : B := True);
- procedure Set_Is_Shared_Passive (Id : E; V : B := True);
- procedure Set_Is_Statically_Allocated (Id : E; V : B := True);
- procedure Set_Is_Synchronized_Interface (Id : E; V : B := True);
- procedure Set_Is_Tag (Id : E; V : B := True);
- procedure Set_Is_Tagged_Type (Id : E; V : B := True);
- procedure Set_Is_Task_Interface (Id : E; V : B := True);
- procedure Set_Is_Thread_Body (Id : E; V : B := True);
- procedure Set_Is_True_Constant (Id : E; V : B := True);
- procedure Set_Is_Unchecked_Union (Id : E; V : B := True);
- procedure Set_Is_Unsigned_Type (Id : E; V : B := True);
- procedure Set_Is_VMS_Exception (Id : E; V : B := True);
- procedure Set_Is_Valued_Procedure (Id : E; V : B := True);
- procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True);
- procedure Set_Is_Visible_Formal (Id : E; V : B := True);
- procedure Set_Is_Volatile (Id : E; V : B := True);
- procedure Set_Itype_Printed (Id : E; V : B := True);
- procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True);
- procedure Set_Kill_Range_Checks (Id : E; V : B := True);
- procedure Set_Kill_Tag_Checks (Id : E; V : B := True);
- procedure Set_Known_To_Have_Preelab_Init (Id : E; V : B := True);
- procedure Set_Last_Assignment (Id : E; V : N);
- procedure Set_Last_Entity (Id : E; V : E);
- procedure Set_Limited_View (Id : E; V : E);
- procedure Set_Lit_Indexes (Id : E; V : E);
- procedure Set_Lit_Strings (Id : E; V : E);
- procedure Set_Low_Bound_Known (Id : E; V : B := True);
- procedure Set_Machine_Radix_10 (Id : E; V : B := True);
- procedure Set_Master_Id (Id : E; V : E);
- procedure Set_Materialize_Entity (Id : E; V : B := True);
- procedure Set_Mechanism (Id : E; V : M);
- procedure Set_Modulus (Id : E; V : U);
- procedure Set_Must_Be_On_Byte_Boundary (Id : E; V : B := True);
- procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True);
- procedure Set_Needs_Debug_Info (Id : E; V : B := True);
- procedure Set_Needs_No_Actuals (Id : E; V : B := True);
- procedure Set_Never_Set_In_Source (Id : E; V : B := True);
- procedure Set_Next_Inlined_Subprogram (Id : E; V : E);
- procedure Set_No_Pool_Assigned (Id : E; V : B := True);
- procedure Set_No_Return (Id : E; V : B := True);
- procedure Set_No_Strict_Aliasing (Id : E; V : B := True);
- procedure Set_Non_Binary_Modulus (Id : E; V : B := True);
- procedure Set_Non_Limited_View (Id : E; V : E);
- procedure Set_Nonzero_Is_True (Id : E; V : B := True);
- procedure Set_Normalized_First_Bit (Id : E; V : U);
- procedure Set_Normalized_Position (Id : E; V : U);
- procedure Set_Normalized_Position_Max (Id : E; V : U);
- procedure Set_Object_Ref (Id : E; V : E);
- procedure Set_Obsolescent_Warning (Id : E; V : N);
- procedure Set_Original_Access_Type (Id : E; V : E);
- procedure Set_Original_Array_Type (Id : E; V : E);
- procedure Set_Original_Record_Component (Id : E; V : E);
- procedure Set_Overridden_Operation (Id : E; V : E);
- procedure Set_Package_Instantiation (Id : E; V : N);
- procedure Set_Packed_Array_Type (Id : E; V : E);
- procedure Set_Parent_Subtype (Id : E; V : E);
- procedure Set_Primitive_Operations (Id : E; V : L);
- procedure Set_Prival (Id : E; V : E);
- procedure Set_Privals_Chain (Id : E; V : L);
- procedure Set_Private_Dependents (Id : E; V : L);
- procedure Set_Private_View (Id : E; V : N);
- procedure Set_Protected_Body_Subprogram (Id : E; V : E);
- procedure Set_Protected_Formal (Id : E; V : E);
- procedure Set_Protected_Operation (Id : E; V : N);
- procedure Set_RM_Size (Id : E; V : U);
- procedure Set_Reachable (Id : E; V : B := True);
- procedure Set_Referenced (Id : E; V : B := True);
- procedure Set_Referenced_As_LHS (Id : E; V : B := True);
- procedure Set_Referenced_Object (Id : E; V : N);
- procedure Set_Register_Exception_Call (Id : E; V : N);
- procedure Set_Related_Array_Object (Id : E; V : E);
- procedure Set_Related_Instance (Id : E; V : E);
- procedure Set_Renamed_Entity (Id : E; V : N);
- procedure Set_Renamed_Object (Id : E; V : N);
- procedure Set_Renaming_Map (Id : E; V : U);
- procedure Set_Return_Present (Id : E; V : B := True);
- procedure Set_Return_Applies_To (Id : E; V : N);
- procedure Set_Returns_By_Ref (Id : E; V : B := True);
- procedure Set_Reverse_Bit_Order (Id : E; V : B := True);
- procedure Set_Scalar_Range (Id : E; V : N);
- procedure Set_Scale_Value (Id : E; V : U);
- procedure Set_Scope_Depth_Value (Id : E; V : U);
- procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True);
- procedure Set_Shadow_Entities (Id : E; V : S);
- procedure Set_Shared_Var_Assign_Proc (Id : E; V : E);
- procedure Set_Shared_Var_Read_Proc (Id : E; V : E);
- procedure Set_Size_Check_Code (Id : E; V : N);
- procedure Set_Size_Depends_On_Discriminant (Id : E; V : B := True);
- procedure Set_Size_Known_At_Compile_Time (Id : E; V : B := True);
- procedure Set_Small_Value (Id : E; V : R);
- procedure Set_Spec_Entity (Id : E; V : E);
- procedure Set_Storage_Size_Variable (Id : E; V : E);
- procedure Set_Stored_Constraint (Id : E; V : L);
- procedure Set_Strict_Alignment (Id : E; V : B := True);
- procedure Set_String_Literal_Length (Id : E; V : U);
- procedure Set_String_Literal_Low_Bound (Id : E; V : N);
- procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True);
- procedure Set_Suppress_Init_Proc (Id : E; V : B := True);
- procedure Set_Suppress_Style_Checks (Id : E; V : B := True);
- procedure Set_Task_Body_Procedure (Id : E; V : N);
- procedure Set_Treat_As_Volatile (Id : E; V : B := True);
- procedure Set_Underlying_Full_View (Id : E; V : E);
- procedure Set_Unset_Reference (Id : E; V : N);
- procedure Set_Uses_Sec_Stack (Id : E; V : B := True);
- procedure Set_Vax_Float (Id : E; V : B := True);
- procedure Set_Warnings_Off (Id : E; V : B := True);
- procedure Set_Was_Hidden (Id : E; V : B := True);
- procedure Set_Wrapped_Entity (Id : E; V : E);
+ procedure Set_Abstract_Interfaces (Id : E; V : L);
+ procedure Set_Accept_Address (Id : E; V : L);
+ procedure Set_Access_Disp_Table (Id : E; V : L);
+ procedure Set_Actual_Subtype (Id : E; V : E);
+ procedure Set_Address_Taken (Id : E; V : B := True);
+ procedure Set_Alias (Id : E; V : E);
+ procedure Set_Abstract_Interface_Alias (Id : E; V : E);
+ procedure Set_Alignment (Id : E; V : U);
+ procedure Set_Associated_Final_Chain (Id : E; V : E);
+ procedure Set_Associated_Formal_Package (Id : E; V : E);
+ procedure Set_Associated_Node_For_Itype (Id : E; V : N);
+ procedure Set_Associated_Storage_Pool (Id : E; V : E);
+ procedure Set_Barrier_Function (Id : E; V : N);
+ procedure Set_Block_Node (Id : E; V : N);
+ procedure Set_Body_Entity (Id : E; V : E);
+ procedure Set_Body_Needed_For_SAL (Id : E; V : B := True);
+ procedure Set_CR_Discriminant (Id : E; V : E);
+ procedure Set_C_Pass_By_Copy (Id : E; V : B := True);
+ procedure Set_Can_Never_Be_Null (Id : E; V : B := True);
+ procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True);
+ procedure Set_Class_Wide_Type (Id : E; V : E);
+ procedure Set_Cloned_Subtype (Id : E; V : E);
+ procedure Set_Component_Alignment (Id : E; V : C);
+ procedure Set_Component_Bit_Offset (Id : E; V : U);
+ procedure Set_Component_Clause (Id : E; V : N);
+ procedure Set_Component_Size (Id : E; V : U);
+ procedure Set_Component_Type (Id : E; V : E);
+ procedure Set_Corresponding_Concurrent_Type (Id : E; V : E);
+ procedure Set_Corresponding_Discriminant (Id : E; V : E);
+ procedure Set_Corresponding_Equality (Id : E; V : E);
+ procedure Set_Corresponding_Record_Type (Id : E; V : E);
+ procedure Set_Corresponding_Remote_Type (Id : E; V : E);
+ procedure Set_Current_Use_Clause (Id : E; V : E);
+ procedure Set_Current_Value (Id : E; V : N);
+ procedure Set_Debug_Info_Off (Id : E; V : B := True);
+ procedure Set_Debug_Renaming_Link (Id : E; V : E);
+ procedure Set_DTC_Entity (Id : E; V : E);
+ procedure Set_DT_Entry_Count (Id : E; V : U);
+ procedure Set_DT_Offset_To_Top_Func (Id : E; V : E);
+ procedure Set_DT_Position (Id : E; V : U);
+ procedure Set_Default_Expr_Function (Id : E; V : E);
+ procedure Set_Default_Expressions_Processed (Id : E; V : B := True);
+ procedure Set_Default_Value (Id : E; V : N);
+ procedure Set_Delay_Cleanups (Id : E; V : B := True);
+ procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True);
+ procedure Set_Delta_Value (Id : E; V : R);
+ procedure Set_Dependent_Instances (Id : E; V : L);
+ procedure Set_Depends_On_Private (Id : E; V : B := True);
+ procedure Set_Digits_Value (Id : E; V : U);
+ procedure Set_Directly_Designated_Type (Id : E; V : E);
+ procedure Set_Discard_Names (Id : E; V : B := True);
+ procedure Set_Discriminal (Id : E; V : E);
+ procedure Set_Discriminal_Link (Id : E; V : E);
+ procedure Set_Discriminant_Checking_Func (Id : E; V : E);
+ procedure Set_Discriminant_Constraint (Id : E; V : L);
+ procedure Set_Discriminant_Default_Value (Id : E; V : N);
+ procedure Set_Discriminant_Number (Id : E; V : U);
+ procedure Set_Elaborate_Body_Desirable (Id : E; V : B := True);
+ procedure Set_Elaboration_Entity (Id : E; V : E);
+ procedure Set_Elaboration_Entity_Required (Id : E; V : B := True);
+ procedure Set_Enclosing_Scope (Id : E; V : E);
+ procedure Set_Entry_Accepted (Id : E; V : B := True);
+ procedure Set_Entry_Bodies_Array (Id : E; V : E);
+ procedure Set_Entry_Cancel_Parameter (Id : E; V : E);
+ procedure Set_Entry_Component (Id : E; V : E);
+ procedure Set_Entry_Formal (Id : E; V : E);
+ procedure Set_Entry_Index_Constant (Id : E; V : E);
+ procedure Set_Entry_Parameters_Type (Id : E; V : E);
+ procedure Set_Enum_Pos_To_Rep (Id : E; V : E);
+ procedure Set_Enumeration_Pos (Id : E; V : U);
+ procedure Set_Enumeration_Rep (Id : E; V : U);
+ procedure Set_Enumeration_Rep_Expr (Id : E; V : N);
+ procedure Set_Equivalent_Type (Id : E; V : E);
+ procedure Set_Esize (Id : E; V : U);
+ procedure Set_Exception_Code (Id : E; V : U);
+ procedure Set_Extra_Accessibility (Id : E; V : E);
+ procedure Set_Extra_Constrained (Id : E; V : E);
+ procedure Set_Extra_Formal (Id : E; V : E);
+ procedure Set_Extra_Formals (Id : E; V : E);
+ procedure Set_Finalization_Chain_Entity (Id : E; V : E);
+ procedure Set_Finalize_Storage_Only (Id : E; V : B := True);
+ procedure Set_First_Entity (Id : E; V : E);
+ procedure Set_First_Index (Id : E; V : N);
+ procedure Set_First_Literal (Id : E; V : E);
+ procedure Set_First_Optional_Parameter (Id : E; V : E);
+ procedure Set_First_Private_Entity (Id : E; V : E);
+ procedure Set_First_Rep_Item (Id : E; V : N);
+ procedure Set_Freeze_Node (Id : E; V : N);
+ procedure Set_From_With_Type (Id : E; V : B := True);
+ procedure Set_Full_View (Id : E; V : E);
+ procedure Set_Function_Returns_With_DSP (Id : E; V : B := True);
+ procedure Set_Generic_Homonym (Id : E; V : E);
+ procedure Set_Generic_Renamings (Id : E; V : L);
+ procedure Set_Handler_Records (Id : E; V : S);
+ procedure Set_Has_Aliased_Components (Id : E; V : B := True);
+ procedure Set_Has_Alignment_Clause (Id : E; V : B := True);
+ procedure Set_Has_All_Calls_Remote (Id : E; V : B := True);
+ procedure Set_Has_Anon_Block_Suffix (Id : E; V : B := True);
+ procedure Set_Has_Atomic_Components (Id : E; V : B := True);
+ procedure Set_Has_Biased_Representation (Id : E; V : B := True);
+ procedure Set_Has_Completion (Id : E; V : B := True);
+ procedure Set_Has_Completion_In_Body (Id : E; V : B := True);
+ procedure Set_Has_Complex_Representation (Id : E; V : B := True);
+ procedure Set_Has_Component_Size_Clause (Id : E; V : B := True);
+ procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True);
+ procedure Set_Has_Contiguous_Rep (Id : E; V : B := True);
+ procedure Set_Has_Controlled_Component (Id : E; V : B := True);
+ procedure Set_Has_Controlling_Result (Id : E; V : B := True);
+ procedure Set_Has_Convention_Pragma (Id : E; V : B := True);
+ procedure Set_Has_Delayed_Freeze (Id : E; V : B := True);
+ procedure Set_Has_Discriminants (Id : E; V : B := True);
+ procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True);
+ procedure Set_Has_Exit (Id : E; V : B := True);
+ procedure Set_Has_External_Tag_Rep_Clause (Id : E; V : B := True);
+ procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True);
+ procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True);
+ procedure Set_Has_Homonym (Id : E; V : B := True);
+ procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True);
+ procedure Set_Has_Master_Entity (Id : E; V : B := True);
+ 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_Forward_Instantiation (Id : E; V : B := True);
+ procedure Set_Has_Non_Standard_Rep (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_Persistent_BSS (Id : E; V : B := True);
+ procedure Set_Has_Pragma_Controlled (Id : E; V : B := True);
+ procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True);
+ procedure Set_Has_Pragma_Inline (Id : E; V : B := True);
+ procedure Set_Has_Pragma_Pack (Id : E; V : B := True);
+ procedure Set_Has_Pragma_Pure (Id : E; V : B := True);
+ procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True);
+ procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True);
+ procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True);
+ procedure Set_Has_Primitive_Operations (Id : E; V : B := True);
+ procedure Set_Has_Private_Declaration (Id : E; V : B := True);
+ procedure Set_Has_Qualified_Name (Id : E; V : B := True);
+ procedure Set_Has_RACW (Id : E; V : B := True);
+ procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True);
+ procedure Set_Has_Recursive_Call (Id : E; V : B := True);
+ procedure Set_Has_Size_Clause (Id : E; V : B := True);
+ procedure Set_Has_Small_Clause (Id : E; V : B := True);
+ procedure Set_Has_Specified_Layout (Id : E; V : B := True);
+ procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True);
+ procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True);
+ procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True);
+ procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True);
+ procedure Set_Has_Static_Discriminants (Id : E; V : B := True);
+ procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True);
+ procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True);
+ procedure Set_Has_Subprogram_Descriptor (Id : E; V : B := True);
+ procedure Set_Has_Task (Id : E; V : B := True);
+ procedure Set_Has_Unchecked_Union (Id : E; V : B := True);
+ procedure Set_Has_Unknown_Discriminants (Id : E; V : B := True);
+ procedure Set_Has_Volatile_Components (Id : E; V : B := True);
+ procedure Set_Has_Xref_Entry (Id : E; V : B := True);
+ procedure Set_Hiding_Loop_Variable (Id : E; V : E);
+ procedure Set_Homonym (Id : E; V : E);
+ procedure Set_In_Package_Body (Id : E; V : B := True);
+ procedure Set_In_Private_Part (Id : E; V : B := True);
+ procedure Set_In_Use (Id : E; V : B := True);
+ procedure Set_Inner_Instances (Id : E; V : L);
+ procedure Set_Interface_Name (Id : E; V : N);
+ procedure Set_Is_AST_Entry (Id : E; V : B := True);
+ procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True);
+ procedure Set_Is_Abstract_Type (Id : E; V : B := True);
+ procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True);
+ procedure Set_Is_Access_Constant (Id : E; V : B := True);
+ procedure Set_Is_Ada_2005_Only (Id : E; V : B := True);
+ procedure Set_Is_Aliased (Id : E; V : B := True);
+ procedure Set_Is_Asynchronous (Id : E; V : B := True);
+ procedure Set_Is_Atomic (Id : E; V : B := True);
+ procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True);
+ procedure Set_Is_CPP_Class (Id : E; V : B := True);
+ procedure Set_Is_Called (Id : E; V : B := True);
+ procedure Set_Is_Character_Type (Id : E; V : B := True);
+ procedure Set_Is_Child_Unit (Id : E; V : B := True);
+ procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True);
+ procedure Set_Is_Compilation_Unit (Id : E; V : B := True);
+ procedure Set_Is_Completely_Hidden (Id : E; V : B := True);
+ procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True);
+ procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True);
+ procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True);
+ procedure Set_Is_Constrained (Id : E; V : B := True);
+ procedure Set_Is_Constructor (Id : E; V : B := True);
+ procedure Set_Is_Controlled (Id : E; V : B := True);
+ procedure Set_Is_Controlling_Formal (Id : E; V : B := True);
+ procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True);
+ procedure Set_Is_Dispatching_Operation (Id : E; V : B := True);
+ procedure Set_Is_Eliminated (Id : E; V : B := True);
+ procedure Set_Is_Entry_Formal (Id : E; V : B := True);
+ procedure Set_Is_Exported (Id : E; V : B := True);
+ procedure Set_Is_First_Subtype (Id : E; V : B := True);
+ procedure Set_Is_For_Access_Subtype (Id : E; V : B := True);
+ procedure Set_Is_Formal_Subprogram (Id : E; V : B := True);
+ procedure Set_Is_Frozen (Id : E; V : B := True);
+ procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True);
+ procedure Set_Is_Generic_Instance (Id : E; V : B := True);
+ procedure Set_Is_Generic_Type (Id : E; V : B := True);
+ procedure Set_Is_Hidden (Id : E; V : B := True);
+ procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True);
+ procedure Set_Is_Immediately_Visible (Id : E; V : B := True);
+ procedure Set_Is_Imported (Id : E; V : B := True);
+ procedure Set_Is_Inlined (Id : E; V : B := True);
+ procedure Set_Is_Interface (Id : E; V : B := True);
+ procedure Set_Is_Instantiated (Id : E; V : B := True);
+ procedure Set_Is_Internal (Id : E; V : B := True);
+ procedure Set_Is_Interrupt_Handler (Id : E; V : B := True);
+ procedure Set_Is_Intrinsic_Subprogram (Id : E; V : B := True);
+ procedure Set_Is_Itype (Id : E; V : B := True);
+ procedure Set_Is_Known_Non_Null (Id : E; V : B := True);
+ procedure Set_Is_Known_Null (Id : E; V : B := True);
+ procedure Set_Is_Known_Valid (Id : E; V : B := True);
+ procedure Set_Is_Limited_Composite (Id : E; V : B := True);
+ procedure Set_Is_Limited_Interface (Id : E; V : B := True);
+ procedure Set_Is_Limited_Record (Id : E; V : B := True);
+ procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True);
+ procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True);
+ procedure Set_Is_Null_Init_Proc (Id : E; V : B := True);
+ procedure Set_Is_Obsolescent (Id : E; V : B := True);
+ procedure Set_Is_Optional_Parameter (Id : E; V : B := True);
+ procedure Set_Is_Overriding_Operation (Id : E; V : B := True);
+ procedure Set_Is_Package_Body_Entity (Id : E; V : B := True);
+ procedure Set_Is_Packed (Id : E; V : B := True);
+ procedure Set_Is_Packed_Array_Type (Id : E; V : B := True);
+ procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True);
+ procedure Set_Is_Preelaborated (Id : E; V : B := True);
+ procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True);
+ procedure Set_Is_Private_Composite (Id : E; V : B := True);
+ procedure Set_Is_Private_Descendant (Id : E; V : B := True);
+ procedure Set_Is_Protected_Interface (Id : E; V : B := True);
+ procedure Set_Is_Public (Id : E; V : B := True);
+ procedure Set_Is_Pure (Id : E; V : B := True);
+ procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True);
+ procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True);
+ procedure Set_Is_Remote_Types (Id : E; V : B := True);
+ procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True);
+ procedure Set_Is_Return_Object (Id : E; V : B := True);
+ procedure Set_Is_Shared_Passive (Id : E; V : B := True);
+ procedure Set_Is_Statically_Allocated (Id : E; V : B := True);
+ procedure Set_Is_Synchronized_Interface (Id : E; V : B := True);
+ procedure Set_Is_Tag (Id : E; V : B := True);
+ procedure Set_Is_Tagged_Type (Id : E; V : B := True);
+ procedure Set_Is_Task_Interface (Id : E; V : B := True);
+ procedure Set_Is_Thread_Body (Id : E; V : B := True);
+ procedure Set_Is_True_Constant (Id : E; V : B := True);
+ procedure Set_Is_Unchecked_Union (Id : E; V : B := True);
+ procedure Set_Is_Unsigned_Type (Id : E; V : B := True);
+ procedure Set_Is_VMS_Exception (Id : E; V : B := True);
+ procedure Set_Is_Valued_Procedure (Id : E; V : B := True);
+ procedure Set_Is_Visible_Child_Unit (Id : E; V : B := True);
+ procedure Set_Is_Visible_Formal (Id : E; V : B := True);
+ procedure Set_Is_Volatile (Id : E; V : B := True);
+ procedure Set_Itype_Printed (Id : E; V : B := True);
+ procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True);
+ procedure Set_Kill_Range_Checks (Id : E; V : B := True);
+ procedure Set_Kill_Tag_Checks (Id : E; V : B := True);
+ procedure Set_Known_To_Have_Preelab_Init (Id : E; V : B := True);
+ procedure Set_Last_Assignment (Id : E; V : N);
+ procedure Set_Last_Entity (Id : E; V : E);
+ procedure Set_Limited_View (Id : E; V : E);
+ procedure Set_Lit_Indexes (Id : E; V : E);
+ procedure Set_Lit_Strings (Id : E; V : E);
+ procedure Set_Low_Bound_Known (Id : E; V : B := True);
+ procedure Set_Machine_Radix_10 (Id : E; V : B := True);
+ procedure Set_Master_Id (Id : E; V : E);
+ procedure Set_Materialize_Entity (Id : E; V : B := True);
+ procedure Set_Mechanism (Id : E; V : M);
+ procedure Set_Modulus (Id : E; V : U);
+ procedure Set_Must_Be_On_Byte_Boundary (Id : E; V : B := True);
+ procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True);
+ procedure Set_Needs_Debug_Info (Id : E; V : B := True);
+ procedure Set_Needs_No_Actuals (Id : E; V : B := True);
+ procedure Set_Never_Set_In_Source (Id : E; V : B := True);
+ procedure Set_Next_Inlined_Subprogram (Id : E; V : E);
+ procedure Set_No_Pool_Assigned (Id : E; V : B := True);
+ procedure Set_No_Return (Id : E; V : B := True);
+ procedure Set_No_Strict_Aliasing (Id : E; V : B := True);
+ procedure Set_Non_Binary_Modulus (Id : E; V : B := True);
+ procedure Set_Non_Limited_View (Id : E; V : E);
+ procedure Set_Nonzero_Is_True (Id : E; V : B := True);
+ procedure Set_Normalized_First_Bit (Id : E; V : U);
+ procedure Set_Normalized_Position (Id : E; V : U);
+ procedure Set_Normalized_Position_Max (Id : E; V : U);
+ procedure Set_Object_Ref (Id : E; V : E);
+ procedure Set_Obsolescent_Warning (Id : E; V : N);
+ procedure Set_Original_Access_Type (Id : E; V : E);
+ procedure Set_Original_Array_Type (Id : E; V : E);
+ procedure Set_Original_Record_Component (Id : E; V : E);
+ procedure Set_Overridden_Operation (Id : E; V : E);
+ procedure Set_Package_Instantiation (Id : E; V : N);
+ procedure Set_Packed_Array_Type (Id : E; V : E);
+ procedure Set_Parent_Subtype (Id : E; V : E);
+ procedure Set_Primitive_Operations (Id : E; V : L);
+ procedure Set_Prival (Id : E; V : E);
+ procedure Set_Privals_Chain (Id : E; V : L);
+ procedure Set_Private_Dependents (Id : E; V : L);
+ procedure Set_Private_View (Id : E; V : N);
+ procedure Set_Protected_Body_Subprogram (Id : E; V : E);
+ procedure Set_Protected_Formal (Id : E; V : E);
+ procedure Set_Protected_Operation (Id : E; V : N);
+ procedure Set_RM_Size (Id : E; V : U);
+ procedure Set_Reachable (Id : E; V : B := True);
+ procedure Set_Referenced (Id : E; V : B := True);
+ procedure Set_Referenced_As_LHS (Id : E; V : B := True);
+ procedure Set_Referenced_Object (Id : E; V : N);
+ procedure Set_Register_Exception_Call (Id : E; V : N);
+ procedure Set_Related_Array_Object (Id : E; V : E);
+ procedure Set_Related_Instance (Id : E; V : E);
+ procedure Set_Renamed_Entity (Id : E; V : N);
+ procedure Set_Renamed_Object (Id : E; V : N);
+ procedure Set_Renaming_Map (Id : E; V : U);
+ procedure Set_Requires_Overriding (Id : E; V : B := True);
+ procedure Set_Return_Present (Id : E; V : B := True);
+ procedure Set_Return_Applies_To (Id : E; V : N);
+ procedure Set_Returns_By_Ref (Id : E; V : B := True);
+ procedure Set_Reverse_Bit_Order (Id : E; V : B := True);
+ procedure Set_Scalar_Range (Id : E; V : N);
+ procedure Set_Scale_Value (Id : E; V : U);
+ procedure Set_Scope_Depth_Value (Id : E; V : U);
+ procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True);
+ procedure Set_Shadow_Entities (Id : E; V : S);
+ procedure Set_Shared_Var_Assign_Proc (Id : E; V : E);
+ procedure Set_Shared_Var_Read_Proc (Id : E; V : E);
+ procedure Set_Size_Check_Code (Id : E; V : N);
+ procedure Set_Size_Depends_On_Discriminant (Id : E; V : B := True);
+ procedure Set_Size_Known_At_Compile_Time (Id : E; V : B := True);
+ procedure Set_Small_Value (Id : E; V : R);
+ procedure Set_Spec_Entity (Id : E; V : E);
+ procedure Set_Storage_Size_Variable (Id : E; V : E);
+ procedure Set_Stored_Constraint (Id : E; V : L);
+ procedure Set_Strict_Alignment (Id : E; V : B := True);
+ procedure Set_String_Literal_Length (Id : E; V : U);
+ procedure Set_String_Literal_Low_Bound (Id : E; V : N);
+ procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True);
+ procedure Set_Suppress_Init_Proc (Id : E; V : B := True);
+ procedure Set_Suppress_Style_Checks (Id : E; V : B := True);
+ procedure Set_Task_Body_Procedure (Id : E; V : N);
+ procedure Set_Treat_As_Volatile (Id : E; V : B := True);
+ procedure Set_Underlying_Full_View (Id : E; V : E);
+ procedure Set_Unset_Reference (Id : E; V : N);
+ procedure Set_Uses_Sec_Stack (Id : E; V : B := True);
+ procedure Set_Vax_Float (Id : E; V : B := True);
+ procedure Set_Warnings_Off (Id : E; V : B := True);
+ procedure Set_Was_Hidden (Id : E; V : B := True);
+ procedure Set_Wrapped_Entity (Id : E; V : E);
-----------------------------------
-- Field Initialization Routines --
-- We define the set of Proc_Next_xxx routines simply for the purposes
-- of inlining them without necessarily inlining the function.
- procedure Proc_Next_Component (N : in out Node_Id);
- procedure Proc_Next_Discriminant (N : in out Node_Id);
- procedure Proc_Next_Formal (N : in out Node_Id);
- procedure Proc_Next_Formal_With_Extras (N : in out Node_Id);
- procedure Proc_Next_Index (N : in out Node_Id);
- procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id);
- procedure Proc_Next_Literal (N : in out Node_Id);
- procedure Proc_Next_Stored_Discriminant (N : in out Node_Id);
+ procedure Proc_Next_Component (N : in out Node_Id);
+ procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id);
+ procedure Proc_Next_Discriminant (N : in out Node_Id);
+ procedure Proc_Next_Formal (N : in out Node_Id);
+ procedure Proc_Next_Formal_With_Extras (N : in out Node_Id);
+ procedure Proc_Next_Index (N : in out Node_Id);
+ procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id);
+ procedure Proc_Next_Literal (N : in out Node_Id);
+ procedure Proc_Next_Stored_Discriminant (N : in out Node_Id);
pragma Inline (Proc_Next_Component);
+ pragma Inline (Proc_Next_Component_Or_Discriminant);
pragma Inline (Proc_Next_Discriminant);
pragma Inline (Proc_Next_Formal);
pragma Inline (Proc_Next_Formal_With_Extras);
pragma Inline (Proc_Next_Literal);
pragma Inline (Proc_Next_Stored_Discriminant);
- procedure Next_Component (N : in out Node_Id)
+ procedure Next_Component (N : in out Node_Id)
renames Proc_Next_Component;
- procedure Next_Discriminant (N : in out Node_Id)
+ procedure Next_Component_Or_Discriminant (N : in out Node_Id)
+ renames Proc_Next_Component;
+
+ procedure Next_Discriminant (N : in out Node_Id)
renames Proc_Next_Discriminant;
- procedure Next_Formal (N : in out Node_Id)
+ procedure Next_Formal (N : in out Node_Id)
renames Proc_Next_Formal;
- procedure Next_Formal_With_Extras (N : in out Node_Id)
+ procedure Next_Formal_With_Extras (N : in out Node_Id)
renames Proc_Next_Formal_With_Extras;
- procedure Next_Index (N : in out Node_Id)
+ procedure Next_Index (N : in out Node_Id)
renames Proc_Next_Index;
- procedure Next_Inlined_Subprogram (N : in out Node_Id)
+ procedure Next_Inlined_Subprogram (N : in out Node_Id)
renames Proc_Next_Inlined_Subprogram;
- procedure Next_Literal (N : in out Node_Id)
+ procedure Next_Literal (N : in out Node_Id)
renames Proc_Next_Literal;
- procedure Next_Stored_Discriminant (N : in out Node_Id)
+ procedure Next_Stored_Discriminant (N : in out Node_Id)
renames Proc_Next_Stored_Discriminant;
----------------------------------------------
----------------------------------------------
-- The First_Rep_Item field of every entity points to a linked list
- -- (linked through Next_Rep_Item) of representation pragmas and
- -- attribute definition clauses that apply to the item. Note that
- -- in the case of types, it is assumed that any such rep items for
- -- a base type also apply to all subtypes. This is implemented by
- -- having the chain for subtypes link onto the chain for the base
- -- type, so that any new entries for the subtype are added at the
- -- start of the chain.
+ -- (linked through Next_Rep_Item) of representation pragmas and attribute
+ -- definition clauses that apply to the item. Note that in the case of
+ -- types, it is assumed that any such rep items for a base type also apply
+ -- to all subtypes. This is implemented by having the chain for subtypes
+ -- link onto the chain for the base type, so that any new entries for the
+ -- subtype are added at the start of the chain.
function Get_Attribute_Definition_Clause
(E : Entity_Id;
Id : Attribute_Id) return Node_Id;
- -- Searches the Rep_Item chain for a given entity E, for an instance
- -- of an attribute definition clause with the given attribute Id. If
- -- found, the value returned is the N_Attribute_Definition_Clause node,
- -- otherwise Empty is returned.
+ -- Searches the Rep_Item chain for a given entity E, for an instance of an
+ -- attribute definition clause with the given attribute Id. If found, the
+ -- value returned is the N_Attribute_Definition_Clause node, otherwise
+ -- Empty is returned.
function Get_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Node_Id;
-- Searches the Rep_Item chain for the given entity E, for an instance
- -- of a representation pragma with the given name Nam. If found then
- -- the value returned is the N_Pragma node, otherwise Empty is returned.
+ -- a representation pragma with the given name Nam. If found then the
+ -- value returned is the N_Pragma node, otherwise Empty is returned.
function Has_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Boolean;
-- Searches the Rep_Item chain for the given entity E, for an instance
function Has_Attribute_Definition_Clause
(E : Entity_Id;
Id : Attribute_Id) return Boolean;
- -- Searches the Rep_Item chain for a given entity E, for an instance
- -- of an attribute definition clause with the given attribute Id. If
- -- found, True is returned, otherwise False indicates that no matching
- -- entry was found.
+ -- Searches the Rep_Item chain for a given entity E, for an instance of an
+ -- attribute definition clause with the given attribute Id. If found, True
+ -- is returned, otherwise False indicates that no matching entry was found.
procedure Record_Rep_Item (E : Entity_Id; N : Node_Id);
-- N is the node for either a representation pragma or an attribute
pragma Inline (Has_Pragma_Pure);
pragma Inline (Has_Pragma_Pure_Function);
pragma Inline (Has_Pragma_Unreferenced);
+ pragma Inline (Has_Pragma_Unreferenced_Objects);
pragma Inline (Has_Primitive_Operations);
pragma Inline (Has_Private_Declaration);
pragma Inline (Has_Qualified_Name);
+ pragma Inline (Has_RACW);
pragma Inline (Has_Record_Rep_Clause);
pragma Inline (Has_Recursive_Call);
pragma Inline (Has_Size_Clause);
pragma Inline (Inner_Instances);
pragma Inline (Interface_Name);
pragma Inline (Is_AST_Entry);
- pragma Inline (Is_Abstract);
+ pragma Inline (Is_Abstract_Subprogram);
+ pragma Inline (Is_Abstract_Type);
pragma Inline (Is_Local_Anonymous_Access);
pragma Inline (Is_Access_Constant);
pragma Inline (Is_Ada_2005_Only);
pragma Inline (Is_Access_Type);
+ pragma Inline (Is_Access_Protected_Subprogram_Type);
pragma Inline (Is_Aliased);
pragma Inline (Is_Array_Type);
pragma Inline (Is_Asynchronous);
pragma Inline (Renamed_Entity);
pragma Inline (Renamed_Object);
pragma Inline (Renaming_Map);
+ pragma Inline (Requires_Overriding);
pragma Inline (Return_Present);
pragma Inline (Return_Applies_To);
pragma Inline (Returns_By_Ref);
pragma Inline (Set_Has_Pragma_Pure);
pragma Inline (Set_Has_Pragma_Pure_Function);
pragma Inline (Set_Has_Pragma_Unreferenced);
+ pragma Inline (Set_Has_Pragma_Unreferenced_Objects);
pragma Inline (Set_Known_To_Have_Preelab_Init);
pragma Inline (Set_Has_Primitive_Operations);
pragma Inline (Set_Has_Private_Declaration);
pragma Inline (Set_Has_Qualified_Name);
+ pragma Inline (Set_Has_RACW);
pragma Inline (Set_Has_Record_Rep_Clause);
pragma Inline (Set_Has_Recursive_Call);
pragma Inline (Set_Has_Size_Clause);
pragma Inline (Set_Inner_Instances);
pragma Inline (Set_Interface_Name);
pragma Inline (Set_Is_AST_Entry);
- pragma Inline (Set_Is_Abstract);
+ pragma Inline (Set_Is_Abstract_Subprogram);
+ pragma Inline (Set_Is_Abstract_Type);
pragma Inline (Set_Is_Local_Anonymous_Access);
pragma Inline (Set_Is_Access_Constant);
pragma Inline (Set_Is_Ada_2005_Only);
pragma Inline (Set_Renamed_Entity);
pragma Inline (Set_Renamed_Object);
pragma Inline (Set_Renaming_Map);
+ pragma Inline (Set_Requires_Overriding);
pragma Inline (Set_Return_Present);
pragma Inline (Set_Return_Applies_To);
pragma Inline (Set_Returns_By_Ref);
with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
+with Exp_Atag; use Exp_Atag;
with Exp_Aggr; use Exp_Aggr;
with Exp_Ch6; use Exp_Ch6;
with Exp_Ch7; use Exp_Ch7;
-- pointers which are not 'part of the value' and must not be changed
-- upon assignment. N is the original Assignment node.
- procedure No_Secondary_Stack_Case (N : Node_Id);
- -- Obsolete code to deal with functions for which
- -- Function_Returns_With_DSP is True.
-
function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean;
-- This function is used in processing the assignment of a record or
-- indexed component. The argument N is either the left hand or right
begin
-- Ada 2005 (AI-327): Handle assignment to priority of protected object
- -- Rewrite an assignment to X'Priority into a run-time call.
+ -- Rewrite an assignment to X'Priority into a run-time call
-- For example: X'Priority := New_Prio_Expr;
-- ...is expanded into Set_Ceiling (X._Object, New_Prio_Expr);
-- Build-in-place function call case. Note that we're not yet doing
-- build-in-place for user-written assignment statements; the
- -- assignment here came from can aggregate.
+ -- assignment here came from an aggregate.
elsif Ada_Version >= Ada_05
and then Is_Build_In_Place_Function_Call (Rhs)
-- In case of assignment to a class-wide tagged type, before
-- the assignment we generate run-time check to ensure that
- -- the tag of the Target is covered by the tag of the source
+ -- the tags of source and target match.
if Is_Class_Wide_Type (Typ)
and then Is_Tagged_Type (Typ)
Append_To (L,
Make_Raise_Constraint_Error (Loc,
Condition =>
- Make_Op_Not (Loc,
- Make_Function_Call (Loc,
- Name => New_Reference_To
- (RTE (RE_CW_Membership), Loc),
- Parameter_Associations => New_List (
+ Make_Op_Ne (Loc,
+ Left_Opnd =>
Make_Selected_Component (Loc,
- Prefix =>
- Duplicate_Subexpr (Lhs),
+ Prefix => Duplicate_Subexpr (Lhs),
Selector_Name =>
- Make_Identifier (Loc, Name_uTag)),
+ Make_Identifier (Loc,
+ Chars => Name_uTag)),
+ Right_Opnd =>
Make_Selected_Component (Loc,
- Prefix =>
- Duplicate_Subexpr (Rhs),
+ Prefix => Duplicate_Subexpr (Rhs),
Selector_Name =>
- Make_Identifier (Loc, Name_uTag))))),
+ Make_Identifier (Loc,
+ Chars => Name_uTag))),
Reason => CE_Tag_Check_Failed));
end if;
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (Op, Loc),
Parameter_Associations => New_List (
- Unchecked_Convert_To (F_Typ, Duplicate_Subexpr (Lhs)),
+ Unchecked_Convert_To (F_Typ,
+ Duplicate_Subexpr (Lhs)),
Unchecked_Convert_To (F_Typ,
Duplicate_Subexpr (Rhs)))));
end;
-- We can't afford to have destructive Finalization Actions
-- in the Self assignment case, so if the target and the
-- source are not obviously different, code is generated to
- -- avoid the self assignment case
- --
+ -- avoid the self assignment case:
+
-- if lhs'address /= rhs'address then
-- <code for controlled and/or tagged assignment>
-- end if;
-- We need to set up an exception handler for implementing
-- 7.6.1 (18). The remaining adjustments are tackled by the
-- implementation of adjust for record_controllers (see
- -- s-finimp.adb)
+ -- s-finimp.adb).
-- This is skipped if we have no finalization
Make_Handled_Sequence_Of_Statements (Loc,
Statements => L,
Exception_Handlers => New_List (
- Make_Exception_Handler (Loc,
+ Make_Implicit_Exception_Handler (Loc,
Exception_Choices =>
New_List (Make_Others_Choice (Loc)),
Statements => New_List (
Make_Handled_Sequence_Of_Statements (Loc, Statements => L)));
-- If no restrictions on aborts, protect the whole assignement
- -- for controlled objects as per 9.8(11)
+ -- for controlled objects as per 9.8(11).
if Controlled_Type (Typ)
and then Expand_Ctrl_Actions
-- initial values might need to be set).
procedure Expand_N_Extended_Return_Statement (N : Node_Id) is
-
- function Is_Build_In_Place_Function (Fun : Entity_Id) return Boolean;
- -- F must be of type E_Function or E_Generic_Function. Return True if it
- -- uses build-in-place for the result object. In Ada 95, this must be
- -- False for inherently limited result type. In Ada 2005, this must be
- -- True for inherently limited result type. For other types, we have a
- -- choice -- build-in-place is usually more efficient for large things,
- -- and less efficient for small things. However, we had better not use
- -- build-in-place if the Convention is other than Ada, because that
- -- would disturb mixed-language programs.
- --
- -- Note that for the non-inherently-limited cases, we must make the same
- -- decision for Ada 95 and 2005, so that mixed-dialect programs work.
- --
- -- ???This function will be needed when compiling the call sites;
- -- we will have to move it to a more global place.
-
- --------------------------------
- -- Is_Build_In_Place_Function --
- --------------------------------
-
- function Is_Build_In_Place_Function (Fun : Entity_Id) return Boolean is
- R_Type : constant Entity_Id := Underlying_Type (Etype (Fun));
-
- begin
- -- First, the cases that matter for correctness
-
- if Is_Inherently_Limited_Type (R_Type) then
- return Ada_Version >= Ada_05 and then not Debug_Flag_Dot_L;
-
- -- Note: If you have Convention (C) on an inherently limited
- -- type, you're on your own. That is, the C code will have to be
- -- carefully written to know about the Ada conventions.
-
- elsif
- Has_Foreign_Convention (R_Type)
- or else
- Has_Foreign_Convention (Fun)
- then
- return False;
-
- -- Second, the efficiency-related decisions. It would be obnoxiously
- -- inefficient to use build-in-place for elementary types. For
- -- composites, we could return False if the subtype is known to be
- -- small (<= one or two words?) but we don't bother with that yet.
-
- else
- return Is_Composite_Type (R_Type);
- end if;
- end Is_Build_In_Place_Function;
-
- ------------------------
- -- Local Declarations --
- ------------------------
-
Loc : constant Source_Ptr := Sloc (N);
Return_Object_Entity : constant Entity_Id :=
Is_Build_In_Place_Function (Parent_Function);
Return_Stm : Node_Id;
+ Statements : List_Id;
Handled_Stm_Seq : Node_Id;
Result : Node_Id;
Exp : Node_Id;
+ function Move_Activation_Chain return Node_Id;
+ -- Construct a call to System.Tasking.Stages.Move_Activation_Chain
+ -- with parameters:
+ -- From current activation chain
+ -- To activation chain passed in by the caller
+ -- New_Master master passed in by the caller
+
+ function Move_Final_List return Node_Id;
+ -- Construct call to System.Finalization_Implementation.Move_Final_List
+ -- with parameters:
+ -- From finalization list of the return statement
+ -- To finalization list passed in by the caller
+
+ ---------------------
+ -- Move_Activation_Chain --
+ ---------------------
+
+ function Move_Activation_Chain return Node_Id is
+ Activation_Chain_Formal : constant Entity_Id :=
+ Build_In_Place_Formal (Parent_Function, BIP_Activation_Chain);
+ To : constant Node_Id :=
+ New_Reference_To (Activation_Chain_Formal, Loc);
+ Master_Formal : constant Entity_Id :=
+ Build_In_Place_Formal (Parent_Function, BIP_Master);
+ New_Master : constant Node_Id :=
+ New_Reference_To (Master_Formal, Loc);
+
+ Chain_Entity : Entity_Id;
+ From : Node_Id;
+ begin
+ Chain_Entity := First_Entity (Return_Statement_Entity (N));
+ while Chars (Chain_Entity) /= Name_uChain loop
+ Chain_Entity := Next_Entity (Chain_Entity);
+ end loop;
+
+ From :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Reference_To (Chain_Entity, Loc),
+ Attribute_Name => Name_Unrestricted_Access);
+ -- ??? I'm not sure why "Make_Identifier (Loc, Name_uChain)" doesn't
+ -- work, instead of "New_Reference_To (Chain_Entity, Loc)" above.
+
+ return
+ Make_Procedure_Call_Statement (Loc,
+ Name => New_Reference_To (RTE (RE_Move_Activation_Chain), Loc),
+ Parameter_Associations => New_List (From, To, New_Master));
+ end Move_Activation_Chain;
+
+ ---------------------
+ -- Move_Final_List --
+ ---------------------
+
+ function Move_Final_List return Node_Id is
+ Flist : constant Entity_Id :=
+ Finalization_Chain_Entity (Return_Statement_Entity (N));
+
+ From : constant Node_Id := New_Reference_To (Flist, Loc);
+
+ Caller_Final_List : constant Entity_Id :=
+ Build_In_Place_Formal
+ (Parent_Function, BIP_Final_List);
+
+ To : constant Node_Id :=
+ New_Reference_To (Caller_Final_List, Loc);
+
+ begin
+ return
+ Make_Procedure_Call_Statement (Loc,
+ Name => New_Reference_To (RTE (RE_Move_Final_List), Loc),
+ Parameter_Associations => New_List (From, To));
+ end Move_Final_List;
+
-- Start of processing for Expand_N_Extended_Return_Statement
begin
Handled_Stm_Seq := Handled_Statement_Sequence (N);
+ -- Build a simple_return_statement that returns the return object when
+ -- there is a statement sequence, or no expression, or the result will
+ -- be built in place. Note however that we currently do this for all
+ -- composite cases, even though nonlimited composite results are not yet
+ -- built in place (though we plan to do so eventually).
+
if Present (Handled_Stm_Seq)
- or else Is_Build_In_Place
+ or else Is_Composite_Type (Etype (Parent_Function))
or else No (Exp)
then
- -- Build simple_return_statement that returns the return object
+ Statements := New_List;
+
+ if Present (Handled_Stm_Seq) then
+ Append_To (Statements, Handled_Stm_Seq);
+ end if;
+
+ -- If control gets past the above Statements, we have successfully
+ -- completed the return statement. If the result type has controlled
+ -- parts, we call Move_Final_List to transfer responsibility for
+ -- finalization of the return object to the caller. An alternative
+ -- would be to declare a Success flag in the function, initialize it
+ -- to False, and set it to True here. Then move the Move_Final_List
+ -- call into the cleanup code, and check Success. If Success then
+ -- Move_Final_List else do finalization. Then we can remove the
+ -- abort-deferral and the nulling-out of the From parameter from
+ -- Move_Final_List. Note that the current method is not quite
+ -- correct in the rather obscure case of a select-then-abort
+ -- statement whose abortable part contains the return statement.
+
+ if Is_Controlled (Etype (Parent_Function))
+ or else Has_Controlled_Component (Etype (Parent_Function))
+ then
+ Append_To (Statements, Move_Final_List);
+ end if;
+
+ -- Similarly to the above Move_Final_List, if the result type
+ -- contains tasks, we call Move_Activation_Chain. Later, the cleanup
+ -- code will call Complete_Master, which will terminate any
+ -- unactivated tasks belonging to the return statement master. But
+ -- Move_Activation_Chain updates their master to be that of the
+ -- caller, so they will not be terminated unless the return
+ -- statement completes unsuccessfully due to exception, abort, goto,
+ -- or exit.
+
+ if Has_Task (Etype (Parent_Function)) then
+ Append_To (Statements, Move_Activation_Chain);
+ end if;
+
+ -- Build a simple_return_statement that returns the return object
Return_Stm :=
Make_Return_Statement (Loc,
Expression => New_Occurrence_Of (Return_Object_Entity, Loc));
+ Append_To (Statements, Return_Stm);
- if Present (Handled_Stm_Seq) then
- Handled_Stm_Seq :=
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => New_List (Handled_Stm_Seq, Return_Stm));
- else
- Handled_Stm_Seq :=
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => New_List (Return_Stm));
- end if;
-
- pragma Assert (Present (Handled_Stm_Seq));
+ Handled_Stm_Seq :=
+ Make_Handled_Sequence_Of_Statements (Loc, Statements);
end if;
-- Case where we build a block
Declarations => Return_Object_Declarations (N),
Handled_Statement_Sequence => Handled_Stm_Seq);
- if Is_Build_In_Place then
+ -- We set the entity of the new block statement to be that of the
+ -- return statement. This is necessary so that various fields, such
+ -- as Finalization_Chain_Entity carry over from the return statement
+ -- to the block. Note that this block is unusual, in that its entity
+ -- is an E_Return_Statement rather than an E_Block.
+
+ Set_Identifier
+ (Result, New_Occurrence_Of (Return_Statement_Entity (N), Loc));
+
+ -- If the object decl was already rewritten as a renaming, then
+ -- we don't want to do the object allocation and transformation of
+ -- of the return object declaration to a renaming. This case occurs
+ -- when the return object is initialized by a call to another
+ -- build-in-place function, and that function is responsible for the
+ -- allocation of the return object.
+
+ if Is_Build_In_Place
+ and then
+ Nkind (Return_Object_Decl) = N_Object_Renaming_Declaration
+ then
+ Set_By_Ref (Return_Stm); -- Return build-in-place results by ref
+
+ elsif Is_Build_In_Place then
-- Locate the implicit access parameter associated with the
-- the caller-supplied return object and convert the return
-- ...
declare
- Return_Obj_Id : constant Entity_Id :=
- Defining_Identifier (Return_Object_Decl);
- Return_Obj_Typ : constant Entity_Id := Etype (Return_Obj_Id);
- Return_Obj_Expr : constant Node_Id :=
- Expression (Return_Object_Decl);
- Obj_Acc_Formal : Entity_Id := Extra_Formals (Parent_Function);
- Obj_Acc_Deref : Node_Id;
- Init_Assignment : Node_Id;
+ Return_Obj_Id : constant Entity_Id :=
+ Defining_Identifier (Return_Object_Decl);
+ Return_Obj_Typ : constant Entity_Id := Etype (Return_Obj_Id);
+ Return_Obj_Expr : constant Node_Id :=
+ Expression (Return_Object_Decl);
+ Result_Subt : constant Entity_Id :=
+ Etype (Parent_Function);
+ Constr_Result : constant Boolean :=
+ Is_Constrained (Result_Subt);
+ Obj_Alloc_Formal : Entity_Id;
+ Object_Access : Entity_Id;
+ Obj_Acc_Deref : Node_Id;
+ Init_Assignment : Node_Id := Empty;
begin
-- Build-in-place results must be returned by reference
Set_By_Ref (Return_Stm);
- -- Locate the implicit access parameter passed by the caller.
- -- It might be better to search for that with a symbol table
- -- lookup, but for now we traverse the extra actuals to find
- -- the access parameter (currently there can only be one).
+ -- Retrieve the implicit access parameter passed by the caller
- while Present (Obj_Acc_Formal) loop
- exit when
- Ekind (Etype (Obj_Acc_Formal)) = E_Anonymous_Access_Type;
- Next_Formal_With_Extras (Obj_Acc_Formal);
- end loop;
+ Object_Access :=
+ Build_In_Place_Formal (Parent_Function, BIP_Object_Access);
- -- ??? pragma Assert (Present (Obj_Acc_Formal));
+ -- If the return object's declaration includes an expression
+ -- and the declaration isn't marked as No_Initialization, then
+ -- we need to generate an assignment to the object and insert
+ -- it after the declaration before rewriting it as a renaming
+ -- (otherwise we'll lose the initialization).
- -- For now we only rewrite the object if we can locate the
- -- implicit access parameter. Normally there should be one
- -- if Build_In_Place is true, but at the moment it's only
- -- created in the more restrictive case of constrained
- -- inherently limited result subtypes. ???
+ if Present (Return_Obj_Expr)
+ and then not No_Initialization (Return_Object_Decl)
+ then
+ Init_Assignment :=
+ Make_Assignment_Statement (Loc,
+ Name => New_Reference_To (Return_Obj_Id, Loc),
+ Expression => Relocate_Node (Return_Obj_Expr));
+ Set_Assignment_OK (Name (Init_Assignment));
+ Set_No_Ctrl_Actions (Init_Assignment);
- if Present (Obj_Acc_Formal) then
+ Set_Parent (Expression (Init_Assignment), Init_Assignment);
- -- If the return object's declaration includes an expression
- -- and the declaration isn't marked as No_Initialization,
- -- then we need to generate an assignment to the object and
- -- insert it after the declaration before rewriting it as
- -- a renaming (otherwise we'll lose the initialization).
+ Set_Expression (Return_Object_Decl, Empty);
- if Present (Return_Obj_Expr)
- and then not No_Initialization (Return_Object_Decl)
+ if Is_Class_Wide_Type (Etype (Return_Obj_Id))
+ and then not Is_Class_Wide_Type
+ (Etype (Expression (Init_Assignment)))
then
- Init_Assignment :=
- Make_Assignment_Statement (Loc,
- Name => New_Reference_To (Return_Obj_Id, Loc),
- Expression => Relocate_Node (Return_Obj_Expr));
- Set_Assignment_OK (Name (Init_Assignment));
- Set_No_Ctrl_Actions (Init_Assignment);
-
- -- ??? Should we be setting the parent of the expression
- -- here?
- -- Set_Parent
- -- (Expression (Init_Assignment), Init_Assignment);
-
- Set_Expression (Return_Object_Decl, Empty);
+ Rewrite (Expression (Init_Assignment),
+ Make_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of
+ (Etype (Return_Obj_Id), Loc),
+ Expression =>
+ Relocate_Node (Expression (Init_Assignment))));
+ end if;
+ if Constr_Result then
Insert_After (Return_Object_Decl, Init_Assignment);
end if;
+ end if;
- -- Replace the return object declaration with a renaming
- -- of a dereference of the implicit access formal.
+ -- When the function's subtype is unconstrained, a run-time
+ -- test is needed to determine the form of allocation to use
+ -- for the return object. The function has an implicit formal
+ -- parameter that indicates this. If the BIP_Alloc_Form formal
+ -- has the value one, then the caller has passed access to an
+ -- existing object for use as the return object. If the value
+ -- is two, then the return object must be allocated on the
+ -- secondary stack. Otherwise, the object must be allocated in
+ -- a storage pool. Currently the last case is only supported
+ -- for the global heap (user-defined storage pools TBD ???). We
+ -- generate an if statement to test the implicit allocation
+ -- formal and initialize a local access value appropriately,
+ -- creating allocators in the secondary stack and global heap
+ -- cases.
+
+ if not Constr_Result then
+ Obj_Alloc_Formal :=
+ Build_In_Place_Formal (Parent_Function, BIP_Alloc_Form);
+
+ declare
+ Ref_Type : Entity_Id;
+ Ptr_Type_Decl : Node_Id;
+ Alloc_Obj_Id : Entity_Id;
+ Alloc_Obj_Decl : Node_Id;
+ Alloc_If_Stmt : Node_Id;
+ SS_Allocator : Node_Id;
+ Heap_Allocator : Node_Id;
+
+ begin
+ -- Reuse the itype created for the function's implicit
+ -- access formal. This avoids the need to create a new
+ -- access type here, plus it allows assigning the access
+ -- formal directly without applying a conversion.
+
+ -- Ref_Type := Etype (Object_Access);
+
+ -- Create an access type designating the function's
+ -- result subtype.
+
+ Ref_Type :=
+ Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
+
+ Ptr_Type_Decl :=
+ Make_Full_Type_Declaration (Loc,
+ Defining_Identifier => Ref_Type,
+ Type_Definition =>
+ Make_Access_To_Object_Definition (Loc,
+ All_Present => True,
+ Subtype_Indication =>
+ New_Reference_To (Return_Obj_Typ, Loc)));
+
+ Insert_Before_And_Analyze
+ (Return_Object_Decl, Ptr_Type_Decl);
+
+ -- Create an access object that will be initialized to an
+ -- access value denoting the return object, either coming
+ -- from an implicit access value passed in by the caller
+ -- or from the result of an allocator.
+
+ Alloc_Obj_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('R'));
+ Set_Etype (Alloc_Obj_Id, Ref_Type);
+
+ Alloc_Obj_Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Alloc_Obj_Id,
+ Object_Definition => New_Reference_To
+ (Ref_Type, Loc));
+
+ Insert_Before_And_Analyze
+ (Return_Object_Decl, Alloc_Obj_Decl);
+
+ -- Create allocators for both the secondary stack and
+ -- global heap. If there's an initialization expression,
+ -- then create these as initialized allocators.
+
+ if Present (Return_Obj_Expr)
+ and then not No_Initialization (Return_Object_Decl)
+ then
+ Heap_Allocator :=
+ Make_Allocator (Loc,
+ Expression =>
+ Make_Qualified_Expression (Loc,
+ Subtype_Mark =>
+ New_Reference_To (Return_Obj_Typ, Loc),
+ Expression =>
+ New_Copy_Tree (Return_Obj_Expr)));
+
+ SS_Allocator := New_Copy_Tree (Heap_Allocator);
+
+ else
+ Heap_Allocator :=
+ Make_Allocator (Loc,
+ New_Reference_To (Return_Obj_Typ, Loc));
- Obj_Acc_Deref :=
- Make_Explicit_Dereference (Loc,
- Prefix => New_Reference_To (Obj_Acc_Formal, Loc));
+ -- If the object requires default initialization then
+ -- that will happen later following the elaboration of
+ -- the object renaming. If we don't turn it off here
+ -- then the object will be default initialized twice.
- Rewrite (Return_Object_Decl,
- Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier => Return_Obj_Id,
- Access_Definition => Empty,
- Subtype_Mark => New_Occurrence_Of
- (Return_Obj_Typ, Loc),
- Name => Obj_Acc_Deref));
+ Set_No_Initialization (Heap_Allocator);
- Set_Renamed_Object (Return_Obj_Id, Obj_Acc_Deref);
+ SS_Allocator := New_Copy_Tree (Heap_Allocator);
+ end if;
+
+ Set_Storage_Pool
+ (SS_Allocator, RTE (RE_SS_Pool));
+ Set_Procedure_To_Call
+ (SS_Allocator, RTE (RE_SS_Allocate));
+
+ -- Create an if statement to test the BIP_Alloc_Form
+ -- formal and initialize the access object to either the
+ -- BIP_Object_Access formal (BIP_Alloc_Form = 0), the
+ -- result of allocaing the object in the secondary stack
+ -- (BIP_Alloc_Form = 1), or else an allocator to create
+ -- the return object in the heap (BIP_Alloc_Form = 2).
+
+ -- ??? An unchecked type conversion must be made in the
+ -- case of assigning the access object formal to the
+ -- local access object, because a normal conversion would
+ -- be illegal in some cases (such as converting access-
+ -- to-unconstrained to access-to-constrained), but the
+ -- the unchecked conversion will presumably fail to work
+ -- right in just such cases. It's not clear at all how to
+ -- handle this. ???
+
+ Alloc_If_Stmt :=
+ Make_If_Statement (Loc,
+ Condition =>
+ Make_Op_Eq (Loc,
+ Left_Opnd =>
+ New_Reference_To (Obj_Alloc_Formal, Loc),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc,
+ UI_From_Int (BIP_Allocation_Form'Pos
+ (Caller_Allocation)))),
+ Then_Statements =>
+ New_List (Make_Assignment_Statement (Loc,
+ Name =>
+ New_Reference_To
+ (Alloc_Obj_Id, Loc),
+ Expression =>
+ Make_Unchecked_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Reference_To (Ref_Type, Loc),
+ Expression =>
+ New_Reference_To
+ (Object_Access, Loc)))),
+ Elsif_Parts =>
+ New_List (Make_Elsif_Part (Loc,
+ Condition =>
+ Make_Op_Eq (Loc,
+ Left_Opnd =>
+ New_Reference_To
+ (Obj_Alloc_Formal, Loc),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc,
+ UI_From_Int (
+ BIP_Allocation_Form'Pos
+ (Secondary_Stack)))),
+ Then_Statements =>
+ New_List
+ (Make_Assignment_Statement (Loc,
+ Name =>
+ New_Reference_To
+ (Alloc_Obj_Id, Loc),
+ Expression =>
+ SS_Allocator)))),
+ Else_Statements =>
+ New_List (Make_Assignment_Statement (Loc,
+ Name =>
+ New_Reference_To
+ (Alloc_Obj_Id, Loc),
+ Expression =>
+ Heap_Allocator)));
+
+ -- If a separate initialization assignment was created
+ -- earlier, append that following the assignment of the
+ -- implicit access formal to the access object, to ensure
+ -- that the return object is initialized in that case.
+
+ if Present (Init_Assignment) then
+ Append_To
+ (Then_Statements (Alloc_If_Stmt),
+ Init_Assignment);
+ end if;
+
+ Insert_After_And_Analyze (Alloc_Obj_Decl, Alloc_If_Stmt);
+
+ -- Remember the local access object for use in the
+ -- dereference of the renaming created below.
+
+ Object_Access := Alloc_Obj_Id;
+ end;
end if;
+
+ -- Replace the return object declaration with a renaming of a
+ -- dereference of the access value designating the return
+ -- object.
+
+ Obj_Acc_Deref :=
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Reference_To (Object_Access, Loc));
+
+ Rewrite (Return_Object_Decl,
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => Return_Obj_Id,
+ Access_Definition => Empty,
+ Subtype_Mark => New_Occurrence_Of
+ (Return_Obj_Typ, Loc),
+ Name => Obj_Acc_Deref));
+
+ Set_Renamed_Object (Return_Obj_Id, Obj_Acc_Deref);
end;
end if;
-- Expand_N_If_Statement --
---------------------------
- -- First we deal with the case of C and Fortran convention boolean
- -- values, with zero/non-zero semantics.
+ -- First we deal with the case of C and Fortran convention boolean values,
+ -- with zero/non-zero semantics.
-- Second, we deal with the obvious rewriting for the cases where the
-- condition of the IF is known at compile time to be True or False.
-- end if;
-- This rewriting is needed if at least one elsif part has a non-empty
- -- Condition_Actions list. We also do the same processing if there is
- -- a constant condition in an elsif part (in conjunction with the first
+ -- Condition_Actions list. We also do the same processing if there is a
+ -- constant condition in an elsif part (in conjunction with the first
-- processing step mentioned above, for the recursive call made to deal
-- with the created inner if, this deals with properly optimizing the
-- cases of constant elsif conditions).
while Compile_Time_Known_Value (Condition (N)) loop
- -- If condition is True, we can simply rewrite the if statement
- -- now by replacing it by the series of then statements.
+ -- If condition is True, we can simply rewrite the if statement now
+ -- by replacing it by the series of then statements.
if Is_True (Expr_Value (Condition (N))) then
-- the Then statements
else
- -- We do not delete the condition if constant condition
- -- warnings are enabled, since otherwise we end up deleting
- -- the desired warning. Of course the backend will get rid
- -- of this True/False test anyway, so nothing is lost here.
+ -- We do not delete the condition if constant condition warnings
+ -- are enabled, since otherwise we end up deleting the desired
+ -- warning. Of course the backend will get rid of this True/False
+ -- test anyway, so nothing is lost here.
if not Constant_Condition_Warnings then
Kill_Dead_Code (Condition (N));
Kill_Dead_Code (Then_Statements (N), Warn_On_Deleted_Code);
- -- If there are no elsif statements, then we simply replace
- -- the entire if statement by the sequence of else statements.
+ -- If there are no elsif statements, then we simply replace the
+ -- entire if statement by the sequence of else statements.
if No (Elsif_Parts (N)) then
if No (Else_Statements (N))
return;
- -- If there are elsif statements, the first of them becomes
- -- the if/then section of the rebuilt if statement This is
- -- the case where we loop to reprocess this copied condition.
+ -- If there are elsif statements, the first of them becomes the
+ -- if/then section of the rebuilt if statement This is the case
+ -- where we loop to reprocess this copied condition.
else
Hed := Remove_Head (Elsif_Parts (N));
while Present (E) loop
Adjust_Condition (Condition (E));
- -- If there are condition actions, then we rewrite the if
- -- statement as indicated above. We also do the same rewrite
- -- if the condition is True or False. The further processing
- -- of this constant condition is then done by the recursive
- -- call to expand the newly created if statement
+ -- If there are condition actions, then rewrite the if statement
+ -- as indicated above. We also do the same rewrite for a True or
+ -- False condition. The further processing of this constant
+ -- condition is then done by the recursive call to expand the
+ -- newly created if statement
if Present (Condition_Actions (E))
or else Compile_Time_Known_Value (Condition (E))
then
- -- Note this is not an implicit if statement, since it is
- -- part of an explicit if statement in the source (or of an
- -- implicit if statement that has already been tested).
+ -- Note this is not an implicit if statement, since it is part
+ -- of an explicit if statement in the source (or of an implicit
+ -- if statement that has already been tested).
New_If :=
Make_If_Statement (Sloc (E),
-- range bounds here, since they were frozen with constant declarations
-- and it is during that process that the validity checking is done.
- -- Handle the case where we have a for loop with the range type being
- -- an enumeration type with non-standard representation. In this case
- -- we expand:
+ -- Handle the case where we have a for loop with the range type being an
+ -- enumeration type with non-standard representation. In this case we
+ -- expand:
-- for x in [reverse] a .. b loop
-- ...
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Loop_Id), 'P'));
- -- If the type has a contiguous representation, successive
- -- values can be generated as offsets from the first literal.
+ -- If the type has a contiguous representation, successive values
+ -- can be generated as offsets from the first literal.
if Has_Contiguous_Rep (Btype) then
Expr :=
Analyze (N);
end;
- -- Second case, if we have a while loop with Condition_Actions set,
- -- then we change it into a plain loop:
+ -- Second case, if we have a while loop with Condition_Actions set, then
+ -- we change it into a plain loop:
-- while C loop
-- ...
Prepend (ES, Statements (N));
Insert_List_Before (ES, Condition_Actions (Isc));
- -- This is not an implicit loop, since it is generated in
- -- response to the loop statement being processed. If this
- -- is itself implicit, the restriction has already been
- -- checked. If not, it is an explicit loop.
+ -- This is not an implicit loop, since it is generated in response
+ -- to the loop statement being processed. If this is itself
+ -- implicit, the restriction has already been checked. If not,
+ -- it is an explicit loop.
Rewrite (N,
Make_Loop_Statement (Sloc (N),
pragma Assert (Is_Entry (Scope_Id));
- -- Look at the enclosing block to see whether the return is from
- -- an accept statement or an entry body.
+ -- Look at the enclosing block to see whether the return is from an
+ -- accept statement or an entry body.
for J in reverse 0 .. Cur_Idx loop
Scope_Id := Scope_Stack.Table (J).Entity;
-- Deal with returning variable length objects and controlled types
- -- Nothing to do if we are returning by reference, or this is not a
- -- type that requires special processing (indicated by the fact that
- -- it requires a cleanup scope for the secondary stack case).
+ -- Nothing to do if we are returning by reference, or this is not type
+ -- that requires special processing (indicated by the fact that it
+ -- requires a cleanup scope for the secondary stack case).
if Is_Inherently_Limited_Type (T) then
null;
end if;
end;
- -- Case of secondary stack not used
-
- elsif Function_Returns_With_DSP (Scope_Id) then
-
- -- The DSP method is no longer in use. We would like to ignore DSP
- -- while implementing AI-318; hence the raise below.
-
- if True then
- raise Program_Error;
- end if;
-
- -- Here what we need to do is to always return by reference, since
- -- we will return with the stack pointer depressed. We may need to
- -- do a copy to a local temporary before doing this return.
-
- No_Secondary_Stack_Case : declare
- Local_Copy_Required : Boolean := False;
- -- Set to True if a local copy is required
-
- Copy_Ent : Entity_Id;
- -- Used for the target entity if a copy is required
-
- Decl : Node_Id;
- -- Declaration used to create copy if needed
-
- procedure Test_Copy_Required (Expr : Node_Id);
- -- Determines if Expr represents a return value for which a
- -- copy is required. More specifically, a copy is not required
- -- if Expr represents an object or component of an object that
- -- is either in the local subprogram frame, or is constant.
- -- If a copy is required, then Local_Copy_Required is set True.
-
- ------------------------
- -- Test_Copy_Required --
- ------------------------
-
- procedure Test_Copy_Required (Expr : Node_Id) is
- Ent : Entity_Id;
-
- begin
- -- If component, test prefix (object containing component)
-
- if Nkind (Expr) = N_Indexed_Component
- or else
- Nkind (Expr) = N_Selected_Component
- then
- Test_Copy_Required (Prefix (Expr));
- return;
-
- -- See if we have an entity name
-
- elsif Is_Entity_Name (Expr) then
- Ent := Entity (Expr);
-
- -- Constant entity is always OK, no copy required
-
- if Ekind (Ent) = E_Constant then
- return;
-
- -- No copy required for local variable
-
- elsif Ekind (Ent) = E_Variable
- and then Scope (Ent) = Current_Subprogram
- then
- return;
- end if;
- end if;
-
- -- All other cases require a copy
-
- Local_Copy_Required := True;
- end Test_Copy_Required;
-
- -- Start of processing for No_Secondary_Stack_Case
-
- begin
- -- No copy needed if result is from a function call.
- -- In this case the result is already being returned by
- -- reference with the stack pointer depressed.
-
- -- To make up for a gcc 2.8.1 deficiency (???), we perform
- -- the copy for array types if the constrained status of the
- -- target type is different from that of the expression.
-
- if Requires_Transient_Scope (T)
- and then
- (not Is_Array_Type (T)
- or else Is_Constrained (T) = Is_Constrained (Return_Type)
- or else Controlled_Type (T))
- and then Nkind (Exp) = N_Function_Call
- then
- Set_By_Ref (N);
-
- -- We always need a local copy for a controlled type, since
- -- we are required to finalize the local value before return.
- -- The copy will automatically include the required finalize.
- -- Moreover, gigi cannot make this copy, since we need special
- -- processing to ensure proper behavior for finalization.
-
- -- Note: the reason we are returning with a depressed stack
- -- pointer in the controlled case (even if the type involved
- -- is constrained) is that we must make a local copy to deal
- -- properly with the requirement that the local result be
- -- finalized.
-
- elsif Controlled_Type (Utyp) then
- Copy_Ent :=
- Make_Defining_Identifier (Loc,
- Chars => New_Internal_Name ('R'));
-
- -- Build declaration to do the copy, and insert it, setting
- -- Assignment_OK, because we may be copying a limited type.
- -- In addition we set the special flag to inhibit finalize
- -- attachment if this is a controlled type (since this attach
- -- must be done by the caller, otherwise if we attach it here
- -- we will finalize the returned result prematurely).
-
- Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Copy_Ent,
- Object_Definition => New_Occurrence_Of (Return_Type, Loc),
- Expression => Relocate_Node (Exp));
-
- Set_Assignment_OK (Decl);
- Set_Delay_Finalize_Attach (Decl);
- Insert_Action (N, Decl);
-
- -- Now the actual return uses the copied value
-
- Rewrite (Exp, New_Occurrence_Of (Copy_Ent, Loc));
- Analyze_And_Resolve (Exp, Return_Type);
-
- -- Since we have made the copy, gigi does not have to, so
- -- we set the By_Ref flag to prevent another copy being made.
-
- Set_By_Ref (N);
-
- -- Non-controlled cases
-
- else
- Test_Copy_Required (Exp);
-
- -- If a local copy is required, then gigi will make the
- -- copy, otherwise, we can return the result directly,
- -- so set By_Ref to suppress the gigi copy.
-
- if not Local_Copy_Required then
- Set_By_Ref (N);
- end if;
- end if;
- end No_Secondary_Stack_Case;
-
-- Here if secondary stack is used
else
-- case either the result is already on the secondary stack, or is
-- already being returned with the stack pointer depressed and no
-- further processing is required except to set the By_Ref flag to
- -- ensure that gigi does not attempt an extra unnecessary copy.
- -- (actually not just unnecessary but harmfully wrong in the case
- -- of a controlled type, where gigi does not know how to do a copy).
- -- To make up for a gcc 2.8.1 deficiency (???), we perform
- -- the copy for array types if the constrained status of the
- -- target type is different from that of the expression.
+ -- ensure that gigi does not attempt an extra unnecessary copy
+ -- (actually not just unnecessary but harmfully wrong in the case of
+ -- a controlled type, where gigi does not know how to do a copy). To
+ -- make up for a gcc 2.8.1 deficiency (???), we perform the copy for
+ -- array types if the constrained status of the target type is
+ -- different from that of the expression.
if Requires_Transient_Scope (T)
and then
then
Set_By_Ref (N);
- -- Remove side effects from the expression now so that
- -- other part of the expander do not have to reanalyze
- -- this node without this optimization
+ -- Remove side effects from the expression now so that other parts
+ -- of the expander do not have to reanalyze the node without this
+ -- optimization.
Rewrite (Exp, Duplicate_Subexpr_No_Checks (Exp));
-- For controlled types, do the allocation on the secondary stack
-- manually in order to call adjust at the right time:
+
-- type Anon1 is access Return_Type;
-- for Anon1'Storage_pool use ss_pool;
-- Anon2 : anon1 := new Return_Type'(expr);
-- return Anon2.all;
+
-- We do the same for classwide types that are not potentially
-- controlled (by the virtue of restriction No_Finalization) because
-- gigi is not able to properly allocate class-wide types.
- elsif Is_Class_Wide_Type (Utyp)
- or else Controlled_Type (Utyp)
- then
+ elsif CW_Or_Controlled_Type (Utyp) then
declare
Loc : constant Source_Ptr := Sloc (N);
Temp : constant Entity_Id :=
end if;
end if;
- -- Implement the rules of 6.5(8-10), which require a tag check in
- -- the case of a limited tagged return type, and tag reassignment
- -- for nonlimited tagged results. These actions are needed when
- -- the return type is a specific tagged type and the result
- -- expression is a conversion or a formal parameter, because in
- -- that case the tag of the expression might differ from the tag
- -- of the specific result type.
+ -- Implement the rules of 6.5(8-10), which require a tag check in the
+ -- case of a limited tagged return type, and tag reassignment for
+ -- nonlimited tagged results. These actions are needed when the return
+ -- type is a specific tagged type and the result expression is a
+ -- conversion or a formal parameter, because in that case the tag of the
+ -- expression might differ from the tag of the specific result type.
if Is_Tagged_Type (Utyp)
and then not Is_Class_Wide_Type (Utyp)
or else (Is_Entity_Name (Exp)
and then Ekind (Entity (Exp)) in Formal_Kind))
then
- -- When the return type is limited, perform a check that the
- -- tag of the result is the same as the tag of the return type.
+ -- When the return type is limited, perform a check that the tag of
+ -- the result is the same as the tag of the return type.
if Is_Limited_Type (Return_Type) then
Insert_Action (Exp,
Loc))),
Reason => CE_Tag_Check_Failed));
- -- If the result type is a specific nonlimited tagged type,
- -- then we have to ensure that the tag of the result is that
- -- of the result type. This is handled by making a copy of the
- -- expression in the case where it might have a different tag,
- -- namely when the expression is a conversion or a formal
- -- parameter. We create a new object of the result type and
- -- initialize it from the expression, which will implicitly
- -- force the tag to be set appropriately.
+ -- If the result type is a specific nonlimited tagged type, then we
+ -- have to ensure that the tag of the result is that of the result
+ -- type. This is handled by making a copy of the expression in the
+ -- case where it might have a different tag, namely when the
+ -- expression is a conversion or a formal parameter. We create a new
+ -- object of the result type and initialize it from the expression,
+ -- which will implicitly force the tag to be set appropriately.
else
Result_Id :=
Condition =>
Make_Op_Gt (Loc,
Left_Opnd =>
- Make_Function_Call (Loc,
- Name =>
- New_Reference_To
- (RTE (RE_Get_Access_Level), Loc),
- Parameter_Associations =>
- New_List (Make_Attribute_Reference (Loc,
- Prefix =>
- Duplicate_Subexpr (Exp),
- Attribute_Name =>
- Name_Tag))),
+ Build_Get_Access_Level (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix => Duplicate_Subexpr (Exp),
+ Attribute_Name => Name_Tag)),
Right_Opnd =>
Make_Integer_Literal (Loc,
Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))),
if Kind = E_Procedure or else Kind = E_Generic_Procedure then
return;
- -- If it is a nested return within an extended one, replace it
- -- with a return of the previously declared return object.
+ -- If it is a nested return within an extended one, replace it with a
+ -- return of the previously declared return object.
elsif Kind = E_Return_Statement then
Rewrite (N,
pragma Assert (Is_Entry (Scope_Id));
- -- Look at the enclosing block to see whether the return is from
- -- an accept statement or an entry body.
+ -- Look at the enclosing block to see whether the return is from an
+ -- accept statement or an entry body.
for J in reverse 0 .. Scope_Stack.Last loop
Scope_Id := Scope_Stack.Table (J).Entity;
Rewrite (N, Goto_Stat);
Analyze (N);
- -- If it is a return from an entry body, put a Complete_Entry_Body
- -- call in front of the return.
+ -- If it is a return from an entry body, put a Complete_Entry_Body call
+ -- in front of the return.
elsif Is_Protected_Type (Scope_Id) then
Call :=
-- The type of the expression (not necessarily the same as R_Type)
begin
- -- The DSP method is no longer in use
-
- pragma Assert (not Function_Returns_With_DSP (Scope_Id));
-
-- We rewrite "return <expression>;" to be:
-- return _anon_ : <return_subtype> := <expression>
-- The expansion produced by Expand_N_Extended_Return_Statement will
- -- contain simple return statements (for example, a block containing a
+ -- contain simple return statements (for example, a block containing
-- simple return of the return object), which brings us back here with
-- Comes_From_Extended_Return_Statement set. To avoid infinite
-- recursion, we do not transform into an extended return if
-- Comes_From_Extended_Return_Statement is True.
-- The reason for this design is that for Ada 2005 limited returns, we
- -- need to reify the return object, so we can build it "in place",
- -- and we need a block statement to hang finalization and tasking stuff
- -- off of.
+ -- need to reify the return object, so we can build it "in place", and
+ -- we need a block statement to hang finalization and tasking stuff.
-- ??? In order to avoid disruption, we avoid translating to extended
-- return except in the cases where we really need to (Ada 2005
-- of an extended return statement (either written by the user, or
-- generated by the above code).
- -- Always normalize C/Fortran boolean result. This is not always
- -- necessary, but it seems a good idea to minimize the passing
- -- around of non-normalized values, and in any case this handles
- -- the processing of barrier functions for protected types, which
- -- turn the condition into a return statement.
+ -- Always normalize C/Fortran boolean result. This is not always needed,
+ -- but it seems a good idea to minimize the passing around of non-
+ -- normalized values, and in any case this handles the processing of
+ -- barrier functions for protected types, which turn the condition into
+ -- a return statement.
if Is_Boolean_Type (Exptyp)
and then Nonzero_Is_True (Exptyp)
end if;
end;
- -- Case of secondary stack not used
-
- elsif Function_Returns_With_DSP (Scope_Id) then
-
- -- The DSP method is no longer in use. We would like to ignore DSP
- -- while implementing AI-318; hence the following assertion. Keep the
- -- old code around in case DSP is revived someday.
-
- pragma Assert (False);
-
- No_Secondary_Stack_Case (N);
-
-- Here if secondary stack is used
else
and then
(not Is_Array_Type (Exptyp)
or else Is_Constrained (Exptyp) = Is_Constrained (R_Type)
- or else Is_Class_Wide_Type (Utyp)
- or else Controlled_Type (Exptyp))
+ or else CW_Or_Controlled_Type (Utyp))
and then Nkind (Exp) = N_Function_Call
then
Set_By_Ref (N);
- -- Remove side effects from the expression now so that
- -- other part of the expander do not have to reanalyze
- -- this node without this optimization
+ -- Remove side effects from the expression now so that other parts
+ -- of the expander do not have to reanalyze this node without this
+ -- optimization
Rewrite (Exp, Duplicate_Subexpr_No_Checks (Exp));
-- controlled (by the virtue of restriction No_Finalization) because
-- gigi is not able to properly allocate class-wide types.
- elsif Is_Class_Wide_Type (Utyp)
- or else Controlled_Type (Utyp)
- then
+ elsif CW_Or_Controlled_Type (Utyp) then
declare
Loc : constant Source_Ptr := Sloc (N);
Temp : constant Entity_Id :=
end if;
end if;
- -- Implement the rules of 6.5(8-10), which require a tag check in
- -- the case of a limited tagged return type, and tag reassignment
- -- for nonlimited tagged results. These actions are needed when
- -- the return type is a specific tagged type and the result
- -- expression is a conversion or a formal parameter, because in
- -- that case the tag of the expression might differ from the tag
- -- of the specific result type.
+ -- Implement the rules of 6.5(8-10), which require a tag check in the
+ -- case of a limited tagged return type, and tag reassignment for
+ -- nonlimited tagged results. These actions are needed when the return
+ -- type is a specific tagged type and the result expression is a
+ -- conversion or a formal parameter, because in that case the tag of the
+ -- expression might differ from the tag of the specific result type.
if Is_Tagged_Type (Utyp)
and then not Is_Class_Wide_Type (Utyp)
Loc))),
Reason => CE_Tag_Check_Failed));
- -- If the result type is a specific nonlimited tagged type,
- -- then we have to ensure that the tag of the result is that
- -- of the result type. This is handled by making a copy of the
- -- expression in the case where it might have a different tag,
- -- namely when the expression is a conversion or a formal
- -- parameter. We create a new object of the result type and
- -- initialize it from the expression, which will implicitly
- -- force the tag to be set appropriately.
+ -- If the result type is a specific nonlimited tagged type, then we
+ -- have to ensure that the tag of the result is that of the result
+ -- type. This is handled by making a copy of the expression in the
+ -- case where it might have a different tag, namely when the
+ -- expression is a conversion or a formal parameter. We create a new
+ -- object of the result type and initialize it from the expression,
+ -- which will implicitly force the tag to be set appropriately.
else
declare
Condition =>
Make_Op_Gt (Loc,
Left_Opnd =>
- Make_Function_Call (Loc,
- Name =>
- New_Reference_To
- (RTE (RE_Get_Access_Level), Loc),
- Parameter_Associations =>
- New_List (Make_Attribute_Reference (Loc,
- Prefix =>
- Duplicate_Subexpr (Exp),
- Attribute_Name =>
- Name_Tag))),
+ Build_Get_Access_Level (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix => Duplicate_Subexpr (Exp),
+ Attribute_Name => Name_Tag)),
Right_Opnd =>
Make_Integer_Literal (Loc,
Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))),
Save_Tag : constant Boolean := Is_Tagged_Type (T)
and then not No_Ctrl_Actions (N)
and then not Java_VM;
- -- Tags are not saved and restored when Java_VM because JVM tags
- -- are represented implicitly in objects.
+ -- Tags are not saved and restored when Java_VM because JVM tags are
+ -- represented implicitly in objects.
Res : List_Id;
Tag_Tmp : Entity_Id;
-- specific to each object of the type, not to the value being assigned.
-- Thus they need to be left intact during the assignment. We achieve
-- this by constructing a Storage_Array subtype, and by overlaying
- -- objects of this type on the source and target of the assignment.
- -- The assignment is then rewritten to assignments of slices of these
+ -- objects of this type on the source and target of the assignment. The
+ -- assignment is then rewritten to assignments of slices of these
-- arrays, copying the user data, and leaving the pointers untouched.
if Ctrl_Act then
(Rec : Entity_Id;
Lo : Node_Id;
Hi : Node_Id) return Node_Id;
- -- Build and return a slice of an array of type S overlaid
- -- on object Rec, with bounds specified by Lo and Hi. If either
- -- bound is empty, a default of S'First (respectively S'Last)
- -- is used.
+ -- Build and return a slice of an array of type S overlaid on
+ -- object Rec, with bounds specified by Lo and Hi. If either bound
+ -- is empty, a default of S'First (respectively S'Last) is used.
-----------------
-- Build_Slice --
Make_Attribute_Reference (Loc,
Prefix => Rec,
Attribute_Name => Name_Address));
- -- Access value designating an opaque storage array of
- -- type S overlaid on record Rec.
+ -- Access value designating an opaque storage array of type S
+ -- overlaid on record Rec.
begin
- -- Compute slice bounds using S'First (1) and S'Last
- -- as default values when not specified by the caller.
+ -- Compute slice bounds using S'First (1) and S'Last as default
+ -- values when not specified by the caller.
if No (Lo) then
Lo_Bound := Make_Integer_Literal (Loc, 1);
return Empty_List;
end Make_Tag_Ctrl_Assignment;
- -----------------------------
- -- No_Secondary_Stack_Case --
- -----------------------------
-
- procedure No_Secondary_Stack_Case (N : Node_Id) is
- pragma Assert (False); -- DSP method no longer in use
-
- Loc : constant Source_Ptr := Sloc (N);
- Exp : constant Node_Id := Expression (N);
- T : constant Entity_Id := Etype (Exp);
- Scope_Id : constant Entity_Id :=
- Return_Applies_To (Return_Statement_Entity (N));
- Return_Type : constant Entity_Id := Etype (Scope_Id);
- Utyp : constant Entity_Id := Underlying_Type (Return_Type);
-
- -- Here what we need to do is to always return by reference, since
- -- we will return with the stack pointer depressed. We may need to
- -- do a copy to a local temporary before doing this return.
-
- Local_Copy_Required : Boolean := False;
- -- Set to True if a local copy is required
-
- Copy_Ent : Entity_Id;
- -- Used for the target entity if a copy is required
-
- Decl : Node_Id;
- -- Declaration used to create copy if needed
-
- procedure Test_Copy_Required (Expr : Node_Id);
- -- Determines if Expr represents a return value for which a
- -- copy is required. More specifically, a copy is not required
- -- if Expr represents an object or component of an object that
- -- is either in the local subprogram frame, or is constant.
- -- If a copy is required, then Local_Copy_Required is set True.
-
- ------------------------
- -- Test_Copy_Required --
- ------------------------
-
- procedure Test_Copy_Required (Expr : Node_Id) is
- Ent : Entity_Id;
-
- begin
- -- If component, test prefix (object containing component)
-
- if Nkind (Expr) = N_Indexed_Component
- or else
- Nkind (Expr) = N_Selected_Component
- then
- Test_Copy_Required (Prefix (Expr));
- return;
-
- -- See if we have an entity name
-
- elsif Is_Entity_Name (Expr) then
- Ent := Entity (Expr);
-
- -- Constant entity is always OK, no copy required
-
- if Ekind (Ent) = E_Constant then
- return;
-
- -- No copy required for local variable
-
- elsif Ekind (Ent) = E_Variable
- and then Scope (Ent) = Current_Subprogram
- then
- return;
- end if;
- end if;
-
- -- All other cases require a copy
-
- Local_Copy_Required := True;
- end Test_Copy_Required;
-
- -- Start of processing for No_Secondary_Stack_Case
-
- begin
- -- No copy needed if result is from a function call.
- -- In this case the result is already being returned by
- -- reference with the stack pointer depressed.
-
- -- To make up for a gcc 2.8.1 deficiency (???), we perform
- -- the copy for array types if the constrained status of the
- -- target type is different from that of the expression.
-
- if Requires_Transient_Scope (T)
- and then
- (not Is_Array_Type (T)
- or else Is_Constrained (T) = Is_Constrained (Return_Type)
- or else Controlled_Type (T))
- and then Nkind (Exp) = N_Function_Call
- then
- Set_By_Ref (N);
-
- -- We always need a local copy for a controlled type, since
- -- we are required to finalize the local value before return.
- -- The copy will automatically include the required finalize.
- -- Moreover, gigi cannot make this copy, since we need special
- -- processing to ensure proper behavior for finalization.
-
- -- Note: the reason we are returning with a depressed stack
- -- pointer in the controlled case (even if the type involved
- -- is constrained) is that we must make a local copy to deal
- -- properly with the requirement that the local result be
- -- finalized.
-
- elsif Controlled_Type (Utyp) then
- Copy_Ent :=
- Make_Defining_Identifier (Loc,
- Chars => New_Internal_Name ('R'));
-
- -- Build declaration to do the copy, and insert it, setting
- -- Assignment_OK, because we may be copying a limited type.
- -- In addition we set the special flag to inhibit finalize
- -- attachment if this is a controlled type (since this attach
- -- must be done by the caller, otherwise if we attach it here
- -- we will finalize the returned result prematurely).
-
- Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Copy_Ent,
- Object_Definition => New_Occurrence_Of (Return_Type, Loc),
- Expression => Relocate_Node (Exp));
-
- Set_Assignment_OK (Decl);
- Set_Delay_Finalize_Attach (Decl);
- Insert_Action (N, Decl);
-
- -- Now the actual return uses the copied value
-
- Rewrite (Exp, New_Occurrence_Of (Copy_Ent, Loc));
- Analyze_And_Resolve (Exp, Return_Type);
-
- -- Since we have made the copy, gigi does not have to, so
- -- we set the By_Ref flag to prevent another copy being made.
-
- Set_By_Ref (N);
-
- -- Non-controlled cases
-
- else
- Test_Copy_Required (Exp);
-
- -- If a local copy is required, then gigi will make the
- -- copy, otherwise, we can return the result directly,
- -- so set By_Ref to suppress the gigi copy.
-
- if not Local_Copy_Required then
- Set_By_Ref (N);
- end if;
- end if;
- end No_Secondary_Stack_Case;
-
------------------------------------
-- Possible_Bit_Aligned_Component --
------------------------------------
end if;
end;
- -- If we have neither a record nor array component, it means that
- -- we have fallen off the top testing prefixes recursively, and
- -- we now have a stand alone object, where we don't have a problem
+ -- If we have neither a record nor array component, it means that we
+ -- have fallen off the top testing prefixes recursively, and we now
+ -- have a stand alone object, where we don't have a problem.
when others =>
return False;
with Einfo; use Einfo;
with Errout; use Errout;
with Elists; use Elists;
+with Exp_Atag; use Exp_Atag;
with Exp_Ch2; use Exp_Ch2;
with Exp_Ch3; use Exp_Ch3;
with Exp_Ch7; use Exp_Ch7;
with Sem_Dist; use Sem_Dist;
with Sem_Mech; use Sem_Mech;
with Sem_Res; use Sem_Res;
-with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
procedure Add_Access_Actual_To_Build_In_Place_Call
(Function_Call : Node_Id;
Function_Id : Entity_Id;
- Return_Object : Node_Id);
+ Return_Object : Node_Id;
+ Is_Access : Boolean := False);
-- Ada 2005 (AI-318-02): Apply the Unrestricted_Access attribute to the
-- object name given by Return_Object and add the attribute to the end of
-- the actual parameter list associated with the build-in-place function
- -- call denoted by Function_Call.
+ -- call denoted by Function_Call. However, if Is_Access is True, then
+ -- Return_Object is already an access expression, in which case it's passed
+ -- along directly to the build-in-place function. Finally, if Return_Object
+ -- is empty, then pass a null literal as the actual.
+
+ procedure Add_Alloc_Form_Actual_To_Build_In_Place_Call
+ (Function_Call : Node_Id;
+ Function_Id : Entity_Id;
+ Alloc_Form : BIP_Allocation_Form := Unspecified;
+ Alloc_Form_Exp : Node_Id := Empty);
+ -- Ada 2005 (AI-318-02): Add an actual indicating the form of allocation,
+ -- if any, to be done by a build-in-place function. If Alloc_Form_Exp is
+ -- present, then use it, otherwise pass a literal corresponding to the
+ -- Alloc_Form parameter (which must not be Unspecified in that case).
+
+ procedure Add_Extra_Actual_To_Call
+ (Subprogram_Call : Node_Id;
+ Extra_Formal : Entity_Id;
+ Extra_Actual : Node_Id);
+ -- Adds Extra_Actual as a named parameter association for the formal
+ -- Extra_Formal in Subprogram_Call.
+
+ procedure Add_Final_List_Actual_To_Build_In_Place_Call
+ (Function_Call : Node_Id;
+ Function_Id : Entity_Id);
+ -- Ada 2005 (AI-318-02): For a build-in-place call, if the result type has
+ -- controlled parts, add an actual parameter that is a pointer to caller's
+ -- finalization list.
+
+ procedure Add_Task_Actuals_To_Build_In_Place_Call
+ (Function_Call : Node_Id;
+ Function_Id : Entity_Id;
+ Master_Actual : Node_Id);
+ -- Ada 2005 (AI-318-02): For a build-in-place call, if the result type
+ -- contains tasks, add two actual parameters: the master, and a pointer to
+ -- the caller's activation chain. Master_Actual is the actual parameter
+ -- expression to pass for the master. In most cases, this is the current
+ -- master (_master). The two exceptions are: If the function call is the
+ -- initialization expression for an allocator, we pass the master of the
+ -- access type. If the function call is the initialization expression for
+ -- a return object, we pass along the master passed in by the caller. The
+ -- activation chain to pass is always the local one.
procedure Check_Overriding_Operation (Subp : Entity_Id);
-- Subp is a dispatching operation. Check whether it may override an
procedure Add_Access_Actual_To_Build_In_Place_Call
(Function_Call : Node_Id;
Function_Id : Entity_Id;
- Return_Object : Node_Id)
+ Return_Object : Node_Id;
+ Is_Access : Boolean := False)
is
Loc : constant Source_Ptr := Sloc (Function_Call);
Obj_Address : Node_Id;
- Obj_Acc_Formal : Node_Id;
- Param_Assoc : Node_Id;
+ Obj_Acc_Formal : Entity_Id;
begin
- -- Locate the implicit access parameter in the called function. Maybe
- -- we should be testing for the name of the access parameter (or perhaps
- -- better, each implicit formal for build-in-place could have an
- -- identifying flag, or a Uint attribute to identify it). ???
+ -- Locate the implicit access parameter in the called function
- Obj_Acc_Formal := Extra_Formals (Function_Id);
+ Obj_Acc_Formal := Build_In_Place_Formal (Function_Id, BIP_Object_Access);
- while Present (Obj_Acc_Formal) loop
- exit when Ekind (Etype (Obj_Acc_Formal)) = E_Anonymous_Access_Type;
- Next_Formal_With_Extras (Obj_Acc_Formal);
- end loop;
+ -- If no return object is provided, then pass null
+
+ if not Present (Return_Object) then
+ Obj_Address := Make_Null (Loc);
- pragma Assert (Present (Obj_Acc_Formal));
+ -- If Return_Object is already an expression of an access type, then use
+ -- it directly, since it must be an access value denoting the return
+ -- object, and couldn't possibly be the return object itself.
+
+ elsif Is_Access then
+ Obj_Address := Return_Object;
-- Apply Unrestricted_Access to caller's return object
- Obj_Address :=
- Make_Attribute_Reference (Loc,
- Prefix => Return_Object,
- Attribute_Name => Name_Unrestricted_Access);
+ else
+ Obj_Address :=
+ Make_Attribute_Reference (Loc,
+ Prefix => Return_Object,
+ Attribute_Name => Name_Unrestricted_Access);
+ end if;
Analyze_And_Resolve (Obj_Address, Etype (Obj_Acc_Formal));
-- Build the parameter association for the new actual and add it to the
-- end of the function's actuals.
+ Add_Extra_Actual_To_Call (Function_Call, Obj_Acc_Formal, Obj_Address);
+ end Add_Access_Actual_To_Build_In_Place_Call;
+
+ --------------------------------------------------
+ -- Add_Alloc_Form_Actual_To_Build_In_Place_Call --
+ --------------------------------------------------
+
+ procedure Add_Alloc_Form_Actual_To_Build_In_Place_Call
+ (Function_Call : Node_Id;
+ Function_Id : Entity_Id;
+ Alloc_Form : BIP_Allocation_Form := Unspecified;
+ Alloc_Form_Exp : Node_Id := Empty)
+ is
+ Loc : constant Source_Ptr := Sloc (Function_Call);
+ Alloc_Form_Actual : Node_Id;
+ Alloc_Form_Formal : Node_Id;
+
+ begin
+ -- Locate the implicit allocation form parameter in the called function.
+ -- Maybe it would be better for each implicit formal of a build-in-place
+ -- function to have a flag or a Uint attribute to identify it. ???
+
+ Alloc_Form_Formal := Build_In_Place_Formal (Function_Id, BIP_Alloc_Form);
+
+ if Present (Alloc_Form_Exp) then
+ pragma Assert (Alloc_Form = Unspecified);
+
+ Alloc_Form_Actual := Alloc_Form_Exp;
+
+ else
+ pragma Assert (Alloc_Form /= Unspecified);
+
+ Alloc_Form_Actual :=
+ Make_Integer_Literal (Loc,
+ Intval => UI_From_Int (BIP_Allocation_Form'Pos (Alloc_Form)));
+ end if;
+
+ Analyze_And_Resolve (Alloc_Form_Actual, Etype (Alloc_Form_Formal));
+
+ -- Build the parameter association for the new actual and add it to the
+ -- end of the function's actuals.
+
+ Add_Extra_Actual_To_Call
+ (Function_Call, Alloc_Form_Formal, Alloc_Form_Actual);
+ end Add_Alloc_Form_Actual_To_Build_In_Place_Call;
+
+ ------------------------------
+ -- Add_Extra_Actual_To_Call --
+ ------------------------------
+
+ procedure Add_Extra_Actual_To_Call
+ (Subprogram_Call : Node_Id;
+ Extra_Formal : Entity_Id;
+ Extra_Actual : Node_Id)
+ is
+ Loc : constant Source_Ptr := Sloc (Subprogram_Call);
+ Param_Assoc : Node_Id;
+
+ begin
Param_Assoc :=
Make_Parameter_Association (Loc,
- Selector_Name => New_Occurrence_Of (Obj_Acc_Formal, Loc),
- Explicit_Actual_Parameter => Obj_Address);
+ Selector_Name => New_Occurrence_Of (Extra_Formal, Loc),
+ Explicit_Actual_Parameter => Extra_Actual);
- Set_Parent (Param_Assoc, Function_Call);
- Set_Parent (Obj_Address, Param_Assoc);
+ Set_Parent (Param_Assoc, Subprogram_Call);
+ Set_Parent (Extra_Actual, Param_Assoc);
- if Present (Parameter_Associations (Function_Call)) then
- if Nkind (Last (Parameter_Associations (Function_Call))) =
+ if Present (Parameter_Associations (Subprogram_Call)) then
+ if Nkind (Last (Parameter_Associations (Subprogram_Call))) =
N_Parameter_Association
then
- Set_Next_Named_Actual
- (Last (Parameter_Associations (Function_Call)),
- Obj_Address);
+
+ -- Find last named actual, and append
+
+ declare
+ L : Node_Id;
+ begin
+ L := First_Actual (Subprogram_Call);
+ while Present (L) loop
+ if No (Next_Actual (L)) then
+ Set_Next_Named_Actual (Parent (L), Extra_Actual);
+ exit;
+ end if;
+ Next_Actual (L);
+ end loop;
+ end;
+
else
- Set_First_Named_Actual (Function_Call, Obj_Address);
+ Set_First_Named_Actual (Subprogram_Call, Extra_Actual);
end if;
- Append (Param_Assoc, To => Parameter_Associations (Function_Call));
+ Append (Param_Assoc, To => Parameter_Associations (Subprogram_Call));
else
- Set_Parameter_Associations (Function_Call, New_List (Param_Assoc));
- Set_First_Named_Actual (Function_Call, Obj_Address);
+ Set_Parameter_Associations (Subprogram_Call, New_List (Param_Assoc));
+ Set_First_Named_Actual (Subprogram_Call, Extra_Actual);
end if;
- end Add_Access_Actual_To_Build_In_Place_Call;
+ end Add_Extra_Actual_To_Call;
+
+ --------------------------------------------------
+ -- Add_Final_List_Actual_To_Build_In_Place_Call --
+ --------------------------------------------------
+
+ procedure Add_Final_List_Actual_To_Build_In_Place_Call
+ (Function_Call : Node_Id;
+ Function_Id : Entity_Id)
+ is
+ Loc : constant Source_Ptr := Sloc (Function_Call);
+ Final_List : Node_Id;
+ Final_List_Actual : Node_Id;
+ Final_List_Formal : Node_Id;
+
+ begin
+ -- No such extra parameter is needed if there are no controlled parts
+
+ if not (Is_Controlled (Etype (Function_Id))
+ or else Has_Controlled_Component (Etype (Function_Id))) then
+ return;
+ end if;
+
+ -- Locate implicit finalization list parameter in the called function
+
+ Final_List_Formal := Build_In_Place_Formal (Function_Id, BIP_Final_List);
+
+ -- Create the actual which is a pointer to the current finalization list
+
+ Final_List := Find_Final_List (Current_Scope);
+ Final_List_Actual :=
+ Make_Attribute_Reference (Loc,
+ Prefix => Final_List,
+ Attribute_Name => Name_Unrestricted_Access);
+
+ Analyze_And_Resolve (Final_List_Actual, Etype (Final_List_Formal));
+
+ -- Build the parameter association for the new actual and add it to the
+ -- end of the function's actuals.
+
+ Add_Extra_Actual_To_Call
+ (Function_Call, Final_List_Formal, Final_List_Actual);
+ end Add_Final_List_Actual_To_Build_In_Place_Call;
+
+ ---------------------------------------------
+ -- Add_Task_Actuals_To_Build_In_Place_Call --
+ ---------------------------------------------
+
+ procedure Add_Task_Actuals_To_Build_In_Place_Call
+ (Function_Call : Node_Id;
+ Function_Id : Entity_Id;
+ Master_Actual : Node_Id)
+ -- Note: Master_Actual can be Empty, but only if there are no tasks
+ is
+ Loc : constant Source_Ptr := Sloc (Function_Call);
+
+ begin
+ -- No such extra parameters are needed if there are no tasks
+
+ if not Has_Task (Etype (Function_Id)) then
+ return;
+ end if;
+
+ -- The master
+
+ declare
+ Master_Formal : Node_Id;
+ begin
+ -- Locate implicit master parameter in the called function
+
+ Master_Formal := Build_In_Place_Formal (Function_Id, BIP_Master);
+
+ Analyze_And_Resolve (Master_Actual, Etype (Master_Formal));
+
+ -- Build the parameter association for the new actual and add it to
+ -- the end of the function's actuals.
+
+ Add_Extra_Actual_To_Call
+ (Function_Call, Master_Formal, Master_Actual);
+ end;
+
+ -- The activation chain
+
+ declare
+ Activation_Chain_Actual : Node_Id;
+ Activation_Chain_Formal : Node_Id;
+ begin
+ -- Locate implicit activation chain parameter in the called function
+
+ Activation_Chain_Formal := Build_In_Place_Formal
+ (Function_Id, BIP_Activation_Chain);
+
+ -- Create the actual which is a pointer to the current activation
+ -- chain
+
+ Activation_Chain_Actual :=
+ Make_Attribute_Reference (Loc,
+ Prefix => Make_Identifier (Loc, Name_uChain),
+ Attribute_Name => Name_Unrestricted_Access);
+
+ Analyze_And_Resolve
+ (Activation_Chain_Actual, Etype (Activation_Chain_Formal));
+
+ -- Build the parameter association for the new actual and add it to
+ -- the end of the function's actuals.
+
+ Add_Extra_Actual_To_Call
+ (Function_Call, Activation_Chain_Formal, Activation_Chain_Actual);
+ end;
+ end Add_Task_Actuals_To_Build_In_Place_Call;
+
+ -----------------------
+ -- BIP_Formal_Suffix --
+ -----------------------
+
+ function BIP_Formal_Suffix (Kind : BIP_Formal_Kind) return String is
+ begin
+ case Kind is
+ when BIP_Alloc_Form =>
+ return "BIPalloc";
+ when BIP_Final_List =>
+ return "BIPfinallist";
+ when BIP_Master =>
+ return "BIPmaster";
+ when BIP_Activation_Chain =>
+ return "BIPactivationchain";
+ when BIP_Object_Access =>
+ return "BIPaccess";
+ end case;
+ end BIP_Formal_Suffix;
+
+ ---------------------------
+ -- Build_In_Place_Formal --
+ ---------------------------
+
+ function Build_In_Place_Formal
+ (Func : Entity_Id;
+ Kind : BIP_Formal_Kind) return Entity_Id
+ is
+ Extra_Formal : Entity_Id := Extra_Formals (Func);
+
+ begin
+ -- Maybe it would be better for each implicit formal of a build-in-place
+ -- function to have a flag or a Uint attribute to identify it. ???
+
+ loop
+ exit when
+ Chars (Extra_Formal) =
+ New_External_Name (Chars (Func), BIP_Formal_Suffix (Kind));
+ Next_Formal_With_Extras (Extra_Formal);
+ end loop;
+
+ pragma Assert (Present (Extra_Formal));
+ return Extra_Formal;
+ end Build_In_Place_Formal;
--------------------------------
-- Check_Overriding_Operation --
-- Ada 2005 (AI-318-02): If the actual parameter is a call to a
-- build-in-place function, then a temporary return object needs
-- to be created and access to it must be passed to the function.
- -- Currently we limit such functions to those with constrained
- -- inherently limited result subtypes, but eventually we plan to
- -- expand the allowed forms of funtions that are treated as
- -- build-in-place.
+ -- Currently we limit such functions to those with inherently
+ -- limited result subtypes, but eventually we plan to expand the
+ -- functions that are treated as build-in-place to include other
+ -- composite result types.
if Ada_Version >= Ada_05
and then Is_Build_In_Place_Function_Call (Actual)
Make_Implicit_If_Statement (N,
Condition =>
Make_Op_Not (Loc,
- Get_Remotely_Callable
- (Duplicate_Subexpr_Move_Checks (Actual))),
+ Build_Get_Remotely_Callable (Loc,
+ Make_Selected_Component (Loc,
+ Prefix => Duplicate_Subexpr_Move_Checks (Actual),
+ Selector_Name =>
+ Make_Identifier (Loc, Name_uTag)))),
Then_Statements => New_List (
Make_Raise_Program_Error (Loc,
Reason => PE_Illegal_RACW_E_4_18))));
Set_Entity (Name (N), Parent_Subp);
- if Is_Abstract (Parent_Subp)
+ if Is_Abstract_Subprogram (Parent_Subp)
and then not In_Instance
then
Error_Msg_NE
-- Handle case of access to protected subprogram type
- if Ekind (Base_Type (Etype (Prefix (Name (N))))) =
- E_Access_Protected_Subprogram_Type
+ if Is_Access_Protected_Subprogram_Type
+ (Base_Type (Etype (Prefix (Name (N)))))
then
-- If this is a call through an access to protected operation,
-- the prefix has the form (object'address, operation'access).
-- If the type returned by the function is unconstrained and the
-- call can be inlined, special processing is required.
+ function Is_Null_Procedure return Boolean;
+ -- Predicate to recognize stubbed procedures and null procedures, for
+ -- which there is no need for the full inlining mechanism.
+
procedure Make_Exit_Label;
-- Build declaration for exit label to be used in Return statements
function Formal_Is_Used_Once (Formal : Entity_Id) return Boolean;
-- Determine whether a formal parameter is used only once in Orig_Bod
+ -----------------------
+ -- Is_Null_Procedure --
+ -----------------------
+
+ function Is_Null_Procedure return Boolean is
+ Decl : constant Node_Id := Unit_Declaration_Node (Subp);
+
+ begin
+ if Ekind (Subp) /= E_Procedure then
+ return False;
+
+ elsif Nkind (Orig_Bod) /= N_Subprogram_Body then
+ return False;
+
+ -- Check if this is an ada 2005 null procedure
+
+ elsif Nkind (Decl) = N_Subprogram_Declaration
+ and then Null_Present (Specification (Decl))
+ then
+ return True;
+
+ -- Check if the body contains only a null statement, followed by the
+ -- return statement added during expansion.
+
+ else
+ declare
+ Stat : constant Node_Id :=
+ First
+ (Statements (Handled_Statement_Sequence (Orig_Bod)));
+
+ Stat2 : constant Node_Id := Next (Stat);
+
+ begin
+ return
+ Nkind (Stat) = N_Null_Statement
+ and then
+ (No (Stat2)
+ or else
+ (Nkind (Stat2) = N_Return_Statement
+ and then No (Next (Stat2))));
+ end;
+ end if;
+ end Is_Null_Procedure;
+
---------------------
-- Make_Exit_Label --
---------------------
(RTE (RE_Address),
Relocate_Node (First_Actual (N))));
return;
+
+ elsif Is_Null_Procedure then
+ Rewrite (N, Make_Null_Statement (Loc));
+ return;
end if;
-- Check for an illegal attempt to inline a recursive procedure. If the
Chars => Name_uE);
Excep_Handlers := New_List (
- Make_Exception_Handler (Loc,
+ Make_Implicit_Exception_Handler (Loc,
Choice_Parameter => Ent_EO,
Exception_Choices => New_List (
Make_Others_Choice (Loc)),
elsif Is_Inherently_Limited_Type (Typ) then
Set_Returns_By_Ref (Spec_Id);
- elsif Present (Utyp)
- and then (Is_Class_Wide_Type (Utyp) or else Controlled_Type (Utyp))
- then
+ elsif Present (Utyp) and then CW_Or_Controlled_Type (Utyp) then
Set_Returns_By_Ref (Spec_Id);
end if;
end;
function Is_Build_In_Place_Function (E : Entity_Id) return Boolean is
begin
-- For now we test whether E denotes a function or access-to-function
- -- type whose result subtype is constrained and inherently limited.
- -- Later this test will be revised to include unconstrained limited
- -- types and composite nonlimited types in general. Functions with
- -- a foreign convention or whose result type has a foreign convention
+ -- type whose result subtype is inherently limited. Later this test may
+ -- be revised to allow composite nonlimited types. Functions with a
+ -- foreign convention or whose result type has a foreign convention
-- never qualify.
if Ekind (E) = E_Function
+ or else Ekind (E) = E_Generic_Function
or else (Ekind (E) = E_Subprogram_Type
and then Etype (E) /= Standard_Void_Type)
then
+ -- Note: If you have Convention (C) on an inherently limited type,
+ -- you're on your own. That is, the C code will have to be carefully
+ -- written to know about the Ada conventions.
+
if Has_Foreign_Convention (E)
or else Has_Foreign_Convention (Etype (E))
then
else
return Is_Inherently_Limited_Type (Etype (E))
- and then Is_Constrained (Etype (E));
+ and then Ada_Version >= Ada_05
+ and then not Debug_Flag_Dot_L;
end if;
else
end if;
end Is_Build_In_Place_Function_Call;
+ ---------------------------------------
+ -- Is_Build_In_Place_Function_Return --
+ ---------------------------------------
+
+ function Is_Build_In_Place_Function_Return (N : Node_Id) return Boolean is
+ begin
+ if Nkind (N) = N_Return_Statement
+ or else Nkind (N) = N_Extended_Return_Statement
+ then
+ return Is_Build_In_Place_Function
+ (Return_Applies_To (Return_Statement_Entity (N)));
+ else
+ return False;
+ end if;
+ end Is_Build_In_Place_Function_Return;
+
-----------------------
-- Freeze_Subprogram --
-----------------------
procedure Register_Predefined_DT_Entry (Prim : Entity_Id) is
Iface_DT_Ptr : Elmt_Id;
- Iface_Typ : Entity_Id;
- Iface_Elmt : Elmt_Id;
Tagged_Typ : Entity_Id;
Thunk_Id : Entity_Id;
Tagged_Typ := Find_Dispatching_Type (Prim);
if No (Access_Disp_Table (Tagged_Typ))
- or else No (Abstract_Interfaces (Tagged_Typ))
+ or else not Has_Abstract_Interfaces (Tagged_Typ)
or else not RTE_Available (RE_Interface_Tag)
+ or else Restriction_Active (No_Dispatching_Calls)
then
return;
end if;
Iface_DT_Ptr :=
Next_Elmt (First_Elmt (Access_Disp_Table (Tagged_Typ)));
- Iface_Elmt := First_Elmt (Abstract_Interfaces (Tagged_Typ));
- while Present (Iface_DT_Ptr) and then Present (Iface_Elmt) loop
- Iface_Typ := Node (Iface_Elmt);
-
- if not Is_Ancestor (Iface_Typ, Tagged_Typ) then
- Thunk_Id :=
- Make_Defining_Identifier (Loc,
- Chars => New_Internal_Name ('T'));
-
- Insert_Actions (N, New_List (
- Expand_Interface_Thunk
- (N => Prim,
- Thunk_Alias => Prim,
- Thunk_Id => Thunk_Id),
-
- Make_DT_Access_Action (Iface_Typ,
- Action => Set_Predefined_Prim_Op_Address,
- Args => New_List (
- Unchecked_Convert_To (RTE (RE_Tag),
- New_Reference_To (Node (Iface_DT_Ptr), Loc)),
-
- Make_Integer_Literal (Loc, DT_Position (Prim)),
-
- Make_Attribute_Reference (Loc,
- Prefix => New_Reference_To (Thunk_Id, Loc),
- Attribute_Name => Name_Address)))));
- end if;
+
+ while Present (Iface_DT_Ptr) loop
+ Thunk_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('T'));
+
+ Insert_Actions (N, New_List (
+ Expand_Interface_Thunk
+ (N => Prim,
+ Thunk_Alias => Prim,
+ Thunk_Id => Thunk_Id),
+
+ Build_Set_Predefined_Prim_Op_Address (Loc,
+ Tag_Node =>
+ New_Reference_To (Node (Iface_DT_Ptr), Loc),
+ Position_Node =>
+ Make_Integer_Literal (Loc, DT_Position (Prim)),
+ Address_Node =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Reference_To (Thunk_Id, Loc),
+ Attribute_Name => Name_Address))));
Next_Elmt (Iface_DT_Ptr);
- Next_Elmt (Iface_Elmt);
end loop;
end Register_Predefined_DT_Entry;
-- whose constructor is in the CPP side (and therefore we don't need
-- to generate code to register them in the dispatch table).
- if not Debug_Flag_QQ
- and then Is_Imported (E)
+ if Is_Imported (E)
and then Convention (E) = Convention_CPP
then
return;
-- the dispatching mechanism is handled internally by the JVM.
if Is_Dispatching_Operation (E)
- and then not Is_Abstract (E)
+ and then not Is_Abstract_Subprogram (E)
and then Present (DTC_Entity (E))
and then not Java_VM
and then not Is_CPP_Class (Scope (DTC_Entity (E)))
-- Ada 95 case: Register the subprogram in the primary dispatch table
- if Ada_Version < Ada_05 then
+ -- Do not register the subprogram in the dispatch table if we are
+ -- compiling under No_Dispatching_Calls restriction.
- -- Do not register the subprogram in the dispatch table if we
- -- are compiling with the No_Dispatching_Calls restriction.
+ if not Restriction_Active (No_Dispatching_Calls) then
- if not Restriction_Active (No_Dispatching_Calls) then
+ if Ada_Version < Ada_05 then
Insert_After (N,
Fill_DT_Entry (Sloc (N), Prim => E));
- end if;
- -- Ada 2005 case: Register the subprogram in the secondary dispatch
- -- tables associated with abstract interfaces.
+ -- Ada 2005 case: Register the subprogram in all the dispatch
+ -- tables associated with the type
- else
- declare
- Typ : constant Entity_Id := Scope (DTC_Entity (E));
+ else
+ declare
+ Typ : constant Entity_Id := Scope (DTC_Entity (E));
- begin
- -- There is no dispatch table associated with abstract
- -- interface types. Each type implementing interfaces will
- -- fill the associated secondary DT entries.
+ begin
+ if not Is_Interface (Typ)
+ and then Is_Predefined_Dispatching_Operation (E)
+ then
+ Register_Predefined_DT_Entry (E);
+ Insert_After (N, Fill_DT_Entry (Sloc (N), Prim => E));
- if not Is_Interface (Typ)
- or else Present (Alias (E))
- then
- -- Ada 2005 (AI-251): Check if this entry corresponds with
- -- a subprogram that covers an abstract interface type.
+ -- There is no dispatch table associated with abstract
+ -- interface types. Each type implementing interfaces will
+ -- fill the associated secondary DT entries.
- if Present (Abstract_Interface_Alias (E)) then
- Register_Interface_DT_Entry (N, E);
+ elsif not Is_Interface (Typ)
+ or else Present (Alias (E))
+ then
+ -- Ada 2005 (AI-251): Check if this entry corresponds
+ -- with a subprogram that covers an abstract interface
+ -- type.
- -- Common case: Primitive subprogram
+ if Present (Abstract_Interface_Alias (E)) then
+ Register_Interface_DT_Entry (N, E);
- else
- -- Generate thunks for all the predefined operations
+ -- Common case: Primitive subprogram
+
+ else
+ -- Generate thunks for all the predefined operations
- if not Restriction_Active (No_Dispatching_Calls) then
if Is_Predefined_Dispatching_Operation (E) then
Register_Predefined_DT_Entry (E);
end if;
Fill_DT_Entry (Sloc (N), Prim => E));
end if;
end if;
- end if;
- end;
+ end;
+ end if;
end if;
end if;
if Is_Inherently_Limited_Type (Typ) then
Set_Returns_By_Ref (E);
- elsif Present (Utyp)
- and then (Is_Class_Wide_Type (Utyp) or else Controlled_Type (Utyp))
- then
+ elsif Present (Utyp) and then CW_Or_Controlled_Type (Utyp) then
Set_Returns_By_Ref (E);
end if;
end;
Result_Subt := Etype (Function_Id);
- -- Replace the initialized allocator of form "new T'(Func (...))" with
- -- an uninitialized allocator of form "new T", where T is the result
- -- subtype of the called function. The call to the function is handled
- -- separately further below.
+ -- When the result subtype is constrained, the return object must be
+ -- allocated on the caller side, and access to it is passed to the
+ -- function.
- New_Allocator :=
- Make_Allocator (Loc, New_Reference_To (Result_Subt, Loc));
- Set_No_Initialization (New_Allocator);
+ if Is_Constrained (Result_Subt) then
- Rewrite (Allocator, New_Allocator);
+ -- Replace the initialized allocator of form "new T'(Func (...))"
+ -- with an uninitialized allocator of form "new T", where T is the
+ -- result subtype of the called function. The call to the function
+ -- is handled separately further below.
- -- Create a new access object and initialize it to the result of the new
- -- uninitialized allocator.
+ New_Allocator :=
+ Make_Allocator (Loc, New_Reference_To (Result_Subt, Loc));
- Return_Obj_Access :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
- Set_Etype (Return_Obj_Access, Acc_Type);
+ Set_Storage_Pool (New_Allocator, Storage_Pool (Allocator));
+ Set_Procedure_To_Call (New_Allocator, Procedure_To_Call (Allocator));
+ Set_No_Initialization (New_Allocator);
- Insert_Action (Allocator,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Return_Obj_Access,
- Object_Definition => New_Reference_To (Acc_Type, Loc),
- Expression => Relocate_Node (Allocator)));
+ Rewrite (Allocator, New_Allocator);
- -- Add an implicit actual to the function call that provides access to
- -- the allocated object. An unchecked conversion to the (specific)
- -- result subtype of the function is inserted to handle the case where
- -- the access type of the allocator has a class-wide designated type.
+ -- Create a new access object and initialize it to the result of the
+ -- new uninitialized allocator.
- Add_Access_Actual_To_Build_In_Place_Call
- (Func_Call,
- Function_Id,
- Make_Unchecked_Type_Conversion (Loc,
- Subtype_Mark => New_Reference_To (Result_Subt, Loc),
- Expression =>
- Make_Explicit_Dereference (Loc,
- Prefix => New_Reference_To (Return_Obj_Access, Loc))));
+ Return_Obj_Access :=
+ Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
+ Set_Etype (Return_Obj_Access, Acc_Type);
+
+ Insert_Action (Allocator,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Return_Obj_Access,
+ Object_Definition => New_Reference_To (Acc_Type, Loc),
+ Expression => Relocate_Node (Allocator)));
+
+ -- Add an implicit actual to the function call that provides access
+ -- to the allocated object. An unchecked conversion to the (specific)
+ -- result subtype of the function is inserted to handle cases where
+ -- the access type of the allocator has a class-wide designated type.
+
+ Add_Final_List_Actual_To_Build_In_Place_Call (Func_Call, Function_Id);
+ Add_Task_Actuals_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Master_Actual => Master_Id (Acc_Type));
+ Add_Access_Actual_To_Build_In_Place_Call
+ (Func_Call,
+ Function_Id,
+ Make_Unchecked_Type_Conversion (Loc,
+ Subtype_Mark => New_Reference_To (Result_Subt, Loc),
+ Expression =>
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Reference_To (Return_Obj_Access, Loc))));
+
+ -- When the result subtype is unconstrained, the function itself must
+ -- perform the allocation of the return object, so we pass parameters
+ -- indicating that. We don't yet handle the case where the allocation
+ -- must be done in a user-defined storage pool, which will require
+ -- passing another actual or two to provide allocation/deallocation
+ -- operations. ???
+
+ else
+ -- Pass an allocation parameter indicating that the function should
+ -- allocate its result on the heap.
+
+ Add_Alloc_Form_Actual_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Alloc_Form => Global_Heap);
+
+ -- The caller does not provide the return object in this case, so we
+ -- have to pass null for the object access actual.
+
+ Add_Final_List_Actual_To_Build_In_Place_Call (Func_Call, Function_Id);
+ Add_Task_Actuals_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Master_Actual => Master_Id (Acc_Type));
+ Add_Access_Actual_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Return_Object => Empty);
+ end if;
-- Finally, replace the allocator node with a reference to the result
-- of the function call itself (which will effectively be an access
Result_Subt := Etype (Function_Id);
- -- Create a temporary object to hold the function result
+ -- When the result subtype is constrained, an object of the subtype is
+ -- declared and an access value designating it is passed as an actual.
- Return_Obj_Id :=
- Make_Defining_Identifier (Loc,
- Chars => New_Internal_Name ('R'));
- Set_Etype (Return_Obj_Id, Result_Subt);
+ if Is_Constrained (Result_Subt) then
- Return_Obj_Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Return_Obj_Id,
- Aliased_Present => True,
- Object_Definition => New_Reference_To (Result_Subt, Loc));
+ -- Create a temporary object to hold the function result
+
+ Return_Obj_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('R'));
+ Set_Etype (Return_Obj_Id, Result_Subt);
- Set_No_Initialization (Return_Obj_Decl);
+ Return_Obj_Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Return_Obj_Id,
+ Aliased_Present => True,
+ Object_Definition => New_Reference_To (Result_Subt, Loc));
- Insert_Action (Func_Call, Return_Obj_Decl);
+ Set_No_Initialization (Return_Obj_Decl);
- -- Add an implicit actual to the function call that provides access to
- -- the caller's return object.
+ Insert_Action (Func_Call, Return_Obj_Decl);
- Add_Access_Actual_To_Build_In_Place_Call
- (Func_Call, Function_Id, New_Reference_To (Return_Obj_Id, Loc));
+ -- Add an implicit actual to the function call that provides access
+ -- to the caller's return object.
+
+ Add_Final_List_Actual_To_Build_In_Place_Call (Func_Call, Function_Id);
+ Add_Task_Actuals_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster));
+ Add_Access_Actual_To_Build_In_Place_Call
+ (Func_Call, Function_Id, New_Reference_To (Return_Obj_Id, Loc));
+
+ -- When the result subtype is unconstrained, the function must allocate
+ -- the return object in the secondary stack, so appropriate implicit
+ -- parameters are added to the call to indicate that. A transient
+ -- scope is established to ensure eventual cleanup of the result.
+
+ else
+ -- Pass an allocation parameter indicating that the function should
+ -- allocate its result on the secondary stack.
+
+ Add_Alloc_Form_Actual_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Alloc_Form => Secondary_Stack);
+
+ -- Pass a null value to the function since no return object is
+ -- available on the caller side.
+
+ Add_Final_List_Actual_To_Build_In_Place_Call (Func_Call, Function_Id);
+ Add_Task_Actuals_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster));
+ Add_Access_Actual_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Empty);
+
+ Establish_Transient_Scope (Func_Call, Sec_Stack => True);
+ end if;
end Make_Build_In_Place_Call_In_Anonymous_Context;
---------------------------------------------------
Result_Subt := Etype (Function_Id);
+ -- When the result subtype is unconstrained, an additional actual must
+ -- be passed to indicate that the caller is providing the return object.
+
+ if not Is_Constrained (Result_Subt) then
+ Add_Alloc_Form_Actual_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
+ end if;
+
-- Add an implicit actual to the function call that provides access to
-- the caller's return object.
+ Add_Final_List_Actual_To_Build_In_Place_Call (Func_Call, Function_Id);
+ Add_Task_Actuals_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster));
Add_Access_Actual_To_Build_In_Place_Call
(Func_Call,
Function_Id,
(Object_Decl : Node_Id;
Function_Call : Node_Id)
is
- Loc : Source_Ptr;
- Func_Call : Node_Id := Function_Call;
- Function_Id : Entity_Id;
- Result_Subt : Entity_Id;
- Ref_Type : Entity_Id;
- Ptr_Typ_Decl : Node_Id;
- Def_Id : Entity_Id;
- New_Expr : Node_Id;
+ Loc : Source_Ptr;
+ Obj_Def_Id : constant Entity_Id :=
+ Defining_Identifier (Object_Decl);
+ Func_Call : Node_Id := Function_Call;
+ Function_Id : Entity_Id;
+ Result_Subt : Entity_Id;
+ Caller_Object : Node_Id;
+ Call_Deref : Node_Id;
+ Ref_Type : Entity_Id;
+ Ptr_Typ_Decl : Node_Id;
+ Def_Id : Entity_Id;
+ New_Expr : Node_Id;
+ Enclosing_Func : Entity_Id;
+ Pass_Caller_Acc : Boolean := False;
begin
if Nkind (Func_Call) = N_Qualified_Expression then
Result_Subt := Etype (Function_Id);
- -- Add an implicit actual to the function call that provides access to
- -- the declared object. An unchecked conversion to the (specific) result
- -- type of the function is inserted to handle the case where the object
- -- is declared with a class-wide type.
+ -- In the constrained case, add an implicit actual to the function call
+ -- that provides access to the declared object. An unchecked conversion
+ -- to the (specific) result type of the function is inserted to handle
+ -- the case where the object is declared with a class-wide type.
+
+ if Is_Constrained (Result_Subt) then
+ Caller_Object :=
+ Make_Unchecked_Type_Conversion (Loc,
+ Subtype_Mark => New_Reference_To (Result_Subt, Loc),
+ Expression => New_Reference_To (Obj_Def_Id, Loc));
+ -- If the function's result subtype is unconstrained and the object is
+ -- a return object of an enclosing build-in-place function, then the
+ -- implicit build-in-place parameters of the enclosing function must be
+ -- passed along to the called function.
+
+ elsif Nkind (Parent (Object_Decl)) = N_Extended_Return_Statement then
+ Pass_Caller_Acc := True;
+
+ Enclosing_Func := Enclosing_Subprogram (Obj_Def_Id);
+
+ -- If the enclosing function has a constrained result type, then
+ -- caller allocation will be used.
+
+ if Is_Constrained (Etype (Enclosing_Func)) then
+ Add_Alloc_Form_Actual_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
+
+ -- Otherwise, when the enclosing function has an unconstrained result
+ -- type, the BIP_Alloc_Form formal of the enclosing function must be
+ -- passed long to the callee.
+
+ else
+ Add_Alloc_Form_Actual_To_Build_In_Place_Call
+ (Func_Call,
+ Function_Id,
+ Alloc_Form_Exp =>
+ New_Reference_To
+ (Build_In_Place_Formal (Enclosing_Func, BIP_Alloc_Form),
+ Loc));
+ end if;
+
+ -- Retrieve the BIPacc formal from the enclosing function and convert
+ -- it to the access type of the callee's BIP_Object_Access formal.
+
+ Caller_Object :=
+ Make_Unchecked_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Reference_To
+ (Etype
+ (Build_In_Place_Formal (Function_Id, BIP_Object_Access)),
+ Loc),
+ Expression =>
+ New_Reference_To
+ (Build_In_Place_Formal (Enclosing_Func, BIP_Object_Access),
+ Loc));
+
+ -- In other unconstrained cases, pass an indication to do the allocation
+ -- on the secondary stack and set Caller_Object to Empty so that a null
+ -- value will be passed for the caller's object address. A transient
+ -- scope is established to ensure eventual cleanup of the result.
+
+ else
+ Add_Alloc_Form_Actual_To_Build_In_Place_Call
+ (Func_Call,
+ Function_Id,
+ Alloc_Form => Secondary_Stack);
+ Caller_Object := Empty;
+
+ Establish_Transient_Scope (Object_Decl, Sec_Stack => True);
+ end if;
+
+ Add_Final_List_Actual_To_Build_In_Place_Call (Func_Call, Function_Id);
+ if Nkind (Parent (Object_Decl)) = N_Extended_Return_Statement
+ and then Has_Task (Result_Subt)
+ then
+ Enclosing_Func := Enclosing_Subprogram (Obj_Def_Id);
+ Add_Task_Actuals_To_Build_In_Place_Call
+ (Func_Call, Function_Id,
+ Master_Actual =>
+ New_Reference_To
+ (Build_In_Place_Formal (Enclosing_Func, BIP_Master), Loc));
+ -- Here we're passing along the master that was passed in to this
+ -- function.
+ else
+ Add_Task_Actuals_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster));
+ end if;
Add_Access_Actual_To_Build_In_Place_Call
- (Func_Call,
- Function_Id,
- Make_Unchecked_Type_Conversion (Loc,
- Subtype_Mark => New_Reference_To (Result_Subt, Loc),
- Expression => New_Reference_To
- (Defining_Identifier (Object_Decl), Loc)));
+ (Func_Call, Function_Id, Caller_Object, Is_Access => Pass_Caller_Acc);
-- Create an access type designating the function's result subtype
Subtype_Indication =>
New_Reference_To (Result_Subt, Loc)));
- Insert_After_And_Analyze (Object_Decl, Ptr_Typ_Decl);
+ -- The access type and its accompanying object must be inserted after
+ -- the object declaration in the constrained case, so that the function
+ -- call can be passed access to the object. In the unconstrained case,
+ -- the access type and object must be inserted before the object, since
+ -- the object declaration is rewritten to be a renaming of a dereference
+ -- of the access object.
+
+ if Is_Constrained (Result_Subt) then
+ Insert_After_And_Analyze (Object_Decl, Ptr_Typ_Decl);
+ else
+ Insert_Before_And_Analyze (Object_Decl, Ptr_Typ_Decl);
+ end if;
-- Finally, create an access object initialized to a reference to the
-- function call.
Object_Definition => New_Reference_To (Ref_Type, Loc),
Expression => New_Expr));
- Set_Expression (Object_Decl, Empty);
- Set_No_Initialization (Object_Decl);
+ if Is_Constrained (Result_Subt) then
+ Set_Expression (Object_Decl, Empty);
+ Set_No_Initialization (Object_Decl);
+
+ -- In case of an unconstrained result subtype, rewrite the object
+ -- declaration as an object renaming where the renamed object is a
+ -- dereference of <function_Call>'reference:
+ --
+ -- Obj : Subt renames <function_call>'Ref.all;
+
+ else
+ Call_Deref :=
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Reference_To (Def_Id, Loc));
+
+ Rewrite (Object_Decl,
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => Make_Defining_Identifier (Loc,
+ New_Internal_Name ('D')),
+ Access_Definition => Empty,
+ Subtype_Mark => New_Occurrence_Of (Result_Subt, Loc),
+ Name => Call_Deref));
+
+ Set_Renamed_Object (Defining_Identifier (Object_Decl), Call_Deref);
+
+ Analyze (Object_Decl);
+
+ -- Replace the internal identifier of the renaming declaration's
+ -- entity with identifier of the original object entity. We also have
+ -- to exchange the entities containing their defining identifiers to
+ -- ensure the correct replacement of the object declaration by the
+ -- object renaming declaration to avoid homograph conflicts (since
+ -- the object declaration's defining identifier was already entered
+ -- in current scope).
+
+ Set_Chars (Defining_Identifier (Object_Decl), Chars (Obj_Def_Id));
+ Exchange_Entities (Defining_Identifier (Object_Decl), Obj_Def_Id);
+ end if;
-- If the object entity has a class-wide Etype, then we need to change
-- it to the result subtype of the function call, because otherwise the
pragma Assert (Is_Interface (Iface_Typ));
- if not Is_Ancestor (Iface_Typ, Tagged_Typ) then
+ if not Is_Parent (Iface_Typ, Tagged_Typ) then
Thunk_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
-- This procedure contains common processing for Expand_N_Function_Call,
-- Expand_N_Procedure_Statement, and Expand_N_Entry_Call.
+ procedure Freeze_Subprogram (N : Node_Id);
+ -- generate the appropriate expansions related to Subprogram freeze
+ -- nodes (e. g. the filling of the corresponding Dispatch Table for
+ -- Primitive Operations)
+
+ -- The following type defines the various forms of allocation used for the
+ -- results of build-in-place function calls.
+
+ type BIP_Allocation_Form is
+ (Unspecified,
+ Caller_Allocation,
+ Secondary_Stack,
+ Global_Heap,
+ User_Storage_Pool);
+
+ type BIP_Formal_Kind is
+ -- Ada 2005 (AI-318-02): This type defines the kinds of implicit extra
+ -- formals created for build-in-place functions. The order of the above
+ -- enumeration literals matches the order in which the formals are
+ -- declared. See Sem_Ch6.Create_Extra_Formals.
+ (BIP_Alloc_Form,
+ -- Present if result subtype is unconstrained. Indicates whether the
+ -- return object is allocated by the caller or callee, and if the
+ -- callee, whether to use the secondary stack or the heap. See
+ -- Create_Extra_Formals.
+ BIP_Final_List,
+ -- Present if result type has controlled parts. Pointer to caller's
+ -- finalization list.
+ BIP_Master,
+ -- Present if result type contains tasks. Master associated with
+ -- calling context.
+ BIP_Activation_Chain,
+ -- Present if result type contains tasks. Caller's activation chain.
+ BIP_Object_Access);
+ -- Present for all build-in-place functions. Address at which to place
+ -- the return object, or null if BIP_Alloc_Form indicates
+ -- allocated by callee.
+ -- ??? We also need to be able to pass in some way to access a
+ -- user-defined storage pool at some point. And perhaps a constrained
+ -- flag.
+
+ function BIP_Formal_Suffix (Kind : BIP_Formal_Kind) return String;
+ -- Ada 2005 (AI-318-02): Returns a string to be used as the suffix of names
+ -- for build-in-place formal parameters of the given kind.
+
+ function Build_In_Place_Formal
+ (Func : Entity_Id;
+ Kind : BIP_Formal_Kind) return Entity_Id;
+ -- Ada 2005 (AI-318-02): Locates and returns the entity for the implicit
+ -- build-in-place formal parameter of the given kind associated with the
+ -- function Func, and returns its Entity_Id. It is a bug if not found; the
+ -- caller should ensure this is called only when the extra formal exists.
+
function Is_Build_In_Place_Function (E : Entity_Id) return Boolean;
- -- Ada 2005 (AI-318-02): Returns True if E denotes a function or an
- -- access-to-function type whose result must be built in place; otherwise
- -- returns False. Currently this is restricted to the subset of functions
- -- whose result subtype is a constrained inherently limited type.
+ -- Ada 2005 (AI-318-02): Returns True if E denotes a function, generic
+ -- function, or access-to-function type whose result must be built in
+ -- place; otherwise returns False. For Ada 2005, this is currently
+ -- restricted to the set of functions whose result subtype is an inherently
+ -- limited type. In Ada 95, this must be False for inherently limited
+ -- result types (but currently returns False for all Ada 95 functions).
+ -- Eventually we plan to support build-in-place for nonlimited types.
+ -- Build-in-place is usually more efficient for large things, and less
+ -- efficient for small things. However, we never use build-in-place if the
+ -- convention is other than Ada, because that would disturb mixed-language
+ -- programs. Note that for the non-inherently-limited cases, we must make
+ -- the same decision for Ada 95 and 2005, so that mixed-dialect programs
+ -- will work.
function Is_Build_In_Place_Function_Call (N : Node_Id) return Boolean;
-- Ada 2005 (AI-318-02): Returns True if N denotes a call to a function
-- that requires handling as a build-in-place call or is a qualified
-- expression applied to such a call; otherwise returns False.
- procedure Freeze_Subprogram (N : Node_Id);
- -- generate the appropriate expansions related to Subprogram freeze
- -- nodes (e. g. the filling of the corresponding Dispatch Table for
- -- Primitive Operations)
+ function Is_Build_In_Place_Function_Return (N : Node_Id) return Boolean;
+ -- Ada 2005 (AI-318-02): Returns True if N is an N_Return_Statement or
+ -- N_Extended_Return_Statement and it applies to a build-in-place function
+ -- or generic function.
procedure Make_Build_In_Place_Call_In_Allocator
(Allocator : Node_Id;
Function_Call : Node_Id);
-- Ada 2005 (AI-318-02): Handle a call to a build-in-place function that
-- occurs as the right-hand side of an assignment statement by passing
- -- access to the left-hand sid as an additional parameter of the function
+ -- access to the left-hand side as an additional parameter of the function
-- call. Assign must denote a N_Assignment_Statement. Function_Call must
-- denote either an N_Function_Call node for which Is_Build_In_Place_Call
-- is True, or an N_Qualified_Expression node applied to such a function
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
with Atree; use Atree;
with Einfo; use Einfo;
+with Exp_Ch6; use Exp_Ch6;
with Exp_Dbug; use Exp_Dbug;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Nlists; use Nlists;
+with Opt; use Opt;
with Sem; use Sem;
with Sem_Ch8; use Sem_Ch8;
with Sinfo; use Sinfo;
end if;
end if;
+ -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
+ -- place function, then a temporary return object needs to be created
+ -- and access to it must be passed to the function. Currently we limit
+ -- such functions to those with inherently limited result subtypes, but
+ -- eventually we plan to expand the functions that are treated as
+ -- build-in-place to include other composite result types.
+
+ if Ada_Version >= Ada_05
+ and then Is_Build_In_Place_Function_Call (Nam)
+ then
+ Make_Build_In_Place_Call_In_Anonymous_Context (Nam);
+ end if;
+
-- Create renaming entry for debug information
Decl := Debug_Renaming_Declaration (N);
package body Rtsfind is
RTE_Available_Call : Boolean := False;
- -- Set True during call to RTE from RTE_Available. Tells RTE to set
- -- RTE_Is_Available to False rather than generating an error message.
+ -- Set True during call to RTE from RTE_Available (or from call to
+ -- RTE_Record_Component from RTE_Record_Component_Available). Tells
+ -- the called subprogram to set RTE_Is_Available to False rather than
+ -- generating an error message.
RTE_Is_Available : Boolean;
-- Set True by RTE_Available on entry. When RTE_Available_Call is set
-- first time, its ID is stored in this array, so that subsequent calls
-- for the same entity can be satisfied immediately.
+ -- NOTE: In order to avoid conflicts between record components and subprgs
+ -- that have the same name (ie. subprogram External_Tag and component
+ -- External_Tag of package Ada.Tags) this table is not used with
+ -- Record_Components.
+
RE_Table : array (RE_Id) of Entity_Id;
--------------------------
-- Local Subprograms --
-----------------------
+ function Check_CRT (E : RE_Id; Eid : Entity_Id) return Entity_Id;
+ -- Check entity Eid to ensure that configurable run-time restrictions
+ -- are met. May generate an error message and raise RE_Not_Available
+ -- if the entity E does not exist (i.e. Eid is Empty)
+
procedure Entity_Not_Defined (Id : RE_Id);
-- Outputs error messages for an entity that is not defined in the
-- run-time library (the form of the error message is tailored for
-- no run time/configurable run time mode as required).
+ function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type;
+ -- Retrieves the Unit Name given a unit id represented by its
+ -- enumeration value in RTU_Id.
+
procedure Load_Fail (S : String; U_Id : RTU_Id; Id : RE_Id);
-- Internal procedure called if we can't sucessfully locate or
-- process a run-time unit. The parameters give information about
-- a normal situation in configurable run-time mode (and the message in
-- this case is suppressed unless we are operating in All_Errors_Mode).
- function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type;
- -- Retrieves the Unit Name given a unit id represented by its
- -- enumeration value in RTU_Id.
-
procedure Load_RTU
(U_Id : RTU_Id;
Id : RE_Id := RE_Null;
-- Id is used only for error message detail, and if it is RE_Null, then
-- the attempt to output the entity name is ignored.
+ function Make_Unit_Name (E : RE_Id; N : Node_Id) return Node_Id;
+ -- If the unit is a child unit, build fully qualified name for use in
+ -- With_Clause.
+
procedure Output_Entity_Name (Id : RE_Id; Msg : String);
-- Output continuation error message giving qualified name of entity
-- corresponding to Id, appending the string given by Msg. This call
-- used if you are sure that the message comes directly or indirectly from
-- a call to the RTE function.
+ ---------------
+ -- Check_CRT --
+ ---------------
+
+ function Check_CRT (E : RE_Id; Eid : Entity_Id) return Entity_Id is
+ U_Id : constant RTU_Id := RE_Unit_Table (E);
+
+ begin
+ if No (Eid) then
+ Entity_Not_Defined (E);
+ raise RE_Not_Available;
+
+ -- Entity is available
+
+ else
+ -- If in No_Run_Time mode and entity is not in one of the
+ -- specially permitted units, raise the exception.
+
+ if No_Run_Time_Mode
+ and then not OK_No_Run_Time_Unit (U_Id)
+ then
+ Entity_Not_Defined (E);
+ raise RE_Not_Available;
+ end if;
+
+ -- Otherwise entity is accessible
+
+ return Eid;
+ end if;
+ end Check_CRT;
+
------------------------
-- Entity_Not_Defined --
------------------------
end if;
end Load_RTU;
+ --------------------
+ -- Make_Unit_Name --
+ --------------------
+
+ function Make_Unit_Name (E : RE_Id; N : Node_Id) return Node_Id is
+ U_Id : constant RTU_Id := RE_Unit_Table (E);
+ U : RT_Unit_Table_Record renames RT_Unit_Table (U_Id);
+ Nam : Node_Id;
+ Scop : Entity_Id;
+
+ begin
+ Nam := New_Reference_To (U.Entity, Standard_Location);
+ Scop := Scope (U.Entity);
+
+ if Nkind (N) = N_Defining_Program_Unit_Name then
+ while Scop /= Standard_Standard loop
+ Nam :=
+ Make_Expanded_Name (Standard_Location,
+ Chars => Chars (U.Entity),
+ Prefix => New_Reference_To (Scop, Standard_Location),
+ Selector_Name => Nam);
+ Set_Entity (Nam, U.Entity);
+
+ Scop := Scope (Scop);
+ end loop;
+ end if;
+
+ return Nam;
+ end Make_Unit_Name;
+
-----------------------
-- Output_Entity_Name --
------------------------
Save_Front_End_Inlining : Boolean;
- function Check_CRT (Eid : Entity_Id) return Entity_Id;
- -- Check entity Eid to ensure that configurable run-time restrictions
- -- are met. May generate an error message and raise RE_Not_Available
- -- if the entity E does not exist (i.e. Eid is Empty)
-
procedure Check_RPC;
-- Reject programs that make use of distribution features not supported
-- on the current target. On such targets (VMS, Vxworks, others?) we
-- This function is used when entity E is in this compilation's main
-- unit. It gets the value from the already compiled declaration.
- function Make_Unit_Name (N : Node_Id) return Node_Id;
- -- If the unit is a child unit, build fully qualified name for use
- -- in With_Clause.
-
- ---------------
- -- Check_CRT --
- ---------------
-
- function Check_CRT (Eid : Entity_Id) return Entity_Id is
- begin
- if No (Eid) then
- Entity_Not_Defined (E);
- raise RE_Not_Available;
-
- -- Entity is available
-
- else
- -- If in No_Run_Time mode and entity is not in one of the
- -- specially permitted units, raise the exception.
-
- if No_Run_Time_Mode
- and then not OK_No_Run_Time_Unit (U_Id)
- then
- Entity_Not_Defined (E);
- raise RE_Not_Available;
- end if;
-
- -- Otherwise entity is accessible
-
- return Eid;
- end if;
- end Check_CRT;
-
---------------
-- Check_RPC --
---------------
end if;
end Check_RPC;
- ------------------------
- -- Find_System_Entity --
- ------------------------
+ -----------------------
+ -- Find_Local_Entity --
+ -----------------------
function Find_Local_Entity (E : RE_Id) return Entity_Id is
RE_Str : String renames RE_Id'Image (E);
return Ent;
end Find_Local_Entity;
- --------------------
- -- Make_Unit_Name --
- --------------------
-
- function Make_Unit_Name (N : Node_Id) return Node_Id is
- Nam : Node_Id;
- Scop : Entity_Id;
-
- begin
- Nam := New_Reference_To (U.Entity, Standard_Location);
- Scop := Scope (U.Entity);
-
- if Nkind (N) = N_Defining_Program_Unit_Name then
- while Scop /= Standard_Standard loop
- Nam :=
- Make_Expanded_Name (Standard_Location,
- Chars => Chars (U.Entity),
- Prefix => New_Reference_To (Scop, Standard_Location),
- Selector_Name => Nam);
- Set_Entity (Nam, U.Entity);
-
- Scop := Scope (Scop);
- end loop;
- end if;
-
- return Nam;
- end Make_Unit_Name;
-
-- Start of processing for RTE
begin
and then Analyzed (Main_Unit_Entity)
and then not Is_Child_Unit (Main_Unit_Entity)
then
- return Check_CRT (Find_Local_Entity (E));
+ return Check_CRT (E, Find_Local_Entity (E));
end if;
Save_Front_End_Inlining := Front_End_Inlining;
-- First we search the package entity chain
- Pkg_Ent := First_Entity (U.Entity);
- while Present (Pkg_Ent) loop
- if Ename = Chars (Pkg_Ent) then
- RE_Table (E) := Pkg_Ent;
- Check_RPC;
- goto Found;
- end if;
+ Pkg_Ent := First_Entity (U.Entity);
+ while Present (Pkg_Ent) loop
+ if Ename = Chars (Pkg_Ent) then
+ RE_Table (E) := Pkg_Ent;
+ Check_RPC;
+ goto Found;
+ end if;
- Next_Entity (Pkg_Ent);
- end loop;
+ Next_Entity (Pkg_Ent);
+ end loop;
-- If we did not find the entity in the package entity chain,
-- then check if the package entity itself matches. Note that
-- a WITH if the current unit is part of the extended main code
-- unit, and if we have not already added the with. The WITH is
-- added to the appropriate unit (the current one). We do not need
- -- to generate a WITH for an ????
+ -- to generate a WITH for a call issued from RTE_Available.
<<Found>>
if (not U.Withed)
Make_With_Clause (Standard_Location,
Name =>
Make_Unit_Name
- (Defining_Unit_Name (Specification (Lib_Unit))));
+ (E, Defining_Unit_Name (Specification (Lib_Unit))));
Set_Library_Unit (Withn, Cunit (U.Unum));
Set_Corresponding_Spec (Withn, U.Entity);
Set_First_Name (Withn, True);
end if;
Front_End_Inlining := Save_Front_End_Inlining;
- return Check_CRT (RE_Table (E));
+ return Check_CRT (E, RE_Table (E));
end RTE;
-------------------
return False;
end RTE_Available;
+ --------------------------
+ -- RTE_Record_Component --
+ --------------------------
+
+ function RTE_Record_Component (E : RE_Id) return Entity_Id is
+ U_Id : constant RTU_Id := RE_Unit_Table (E);
+ U : RT_Unit_Table_Record renames RT_Unit_Table (U_Id);
+ E1 : Entity_Id;
+ Ename : Name_Id;
+ Lib_Unit : Node_Id;
+ Pkg_Ent : Entity_Id;
+
+ -- The following flag is used to disable front-end inlining when
+ -- RTE_Record_Component is invoked. This prevents the analysis of other
+ -- runtime bodies when a particular spec is loaded through Rtsfind. This
+ -- is both efficient, and it prevents spurious visibility conflicts
+ -- between use-visible user entities, and entities in run-time packages.
+
+ -- In configurable run-time mode, subprograms marked Inlined_Always must
+ -- be inlined, so in the case we retain the Front_End_Inlining mode.
+
+ Save_Front_End_Inlining : Boolean;
+
+ begin
+ -- Note: Contrary to subprogram RTE, there is no need to do any special
+ -- management with package system.ads because it has no record type
+ -- declarations.
+
+ Save_Front_End_Inlining := Front_End_Inlining;
+ Front_End_Inlining := Configurable_Run_Time_Mode;
+
+ -- Load unit if unit not previously loaded
+
+ if not Present (U.Entity) then
+ Load_RTU (U_Id, Id => E);
+ end if;
+
+ Lib_Unit := Unit (Cunit (U.Unum));
+
+ pragma Assert (Nkind (Lib_Unit) = N_Package_Declaration);
+ Ename := RE_Chars (E);
+
+ -- Search the entity in the components of record type declarations
+ -- found in the package entity chain.
+
+ Pkg_Ent := First_Entity (U.Entity);
+ Search : while Present (Pkg_Ent) loop
+ if Is_Record_Type (Pkg_Ent) then
+ E1 := First_Entity (Pkg_Ent);
+ while Present (E1) loop
+ if Ename = Chars (E1) then
+ exit Search;
+ end if;
+
+ Next_Entity (E1);
+ end loop;
+ end if;
+
+ Next_Entity (Pkg_Ent);
+ end loop Search;
+
+ -- If we didn't find the entity we want, something is wrong. The
+ -- appropriate action will be taken by Check_CRT when we exit.
+
+ -- Cenerate a with-clause if the current unit is part of the extended
+ -- main code unit, and if we have not already added the with. The clause
+ -- is added to the appropriate unit (the current one). We do not need to
+ -- generate it for a call issued from RTE_Component_Available.
+
+ if (not U.Withed)
+ and then
+ In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit))
+ and then not RTE_Available_Call
+ then
+ U.Withed := True;
+
+ declare
+ Withn : Node_Id;
+ Lib_Unit : Node_Id;
+
+ begin
+ Lib_Unit := Unit (Cunit (U.Unum));
+ Withn :=
+ Make_With_Clause (Standard_Location,
+ Name =>
+ Make_Unit_Name
+ (E, Defining_Unit_Name (Specification (Lib_Unit))));
+ Set_Library_Unit (Withn, Cunit (U.Unum));
+ Set_Corresponding_Spec (Withn, U.Entity);
+ Set_First_Name (Withn, True);
+ Set_Implicit_With (Withn, True);
+
+ Mark_Rewrite_Insertion (Withn);
+ Append (Withn, Context_Items (Cunit (Current_Sem_Unit)));
+ Check_Restriction_No_Dependence (Name (Withn), Current_Error_Node);
+ end;
+ end if;
+
+ Front_End_Inlining := Save_Front_End_Inlining;
+ return Check_CRT (E, E1);
+ end RTE_Record_Component;
+
+ ------------------------------------
+ -- RTE_Record_Component_Available --
+ ------------------------------------
+
+ function RTE_Record_Component_Available (E : RE_Id) return Boolean is
+ Dummy : Entity_Id;
+ pragma Warnings (Off, Dummy);
+
+ Result : Boolean;
+
+ Save_RTE_Available_Call : constant Boolean := RTE_Available_Call;
+ Save_RTE_Is_Available : constant Boolean := RTE_Is_Available;
+ -- These are saved recursively because the call to load a unit
+ -- caused by an upper level call may perform a recursive call
+ -- to this routine during analysis of the corresponding unit.
+
+ begin
+ RTE_Available_Call := True;
+ RTE_Is_Available := True;
+ Dummy := RTE_Record_Component (E);
+ Result := RTE_Is_Available;
+ RTE_Available_Call := Save_RTE_Available_Call;
+ RTE_Is_Available := Save_RTE_Is_Available;
+ return Result;
+
+ exception
+ when RE_Not_Available =>
+ RTE_Available_Call := Save_RTE_Available_Call;
+ RTE_Is_Available := Save_RTE_Is_Available;
+ return False;
+ end RTE_Record_Component_Available;
+
-------------------
-- RTE_Error_Msg --
-------------------
end if;
end RTE_Error_Msg;
+ ----------------
+ -- RTU_Entity --
+ ----------------
+
+ function RTU_Entity (U : RTU_Id) return Entity_Id is
+ begin
+ return RT_Unit_Table (U).Entity;
+ end RTU_Entity;
+
----------------
-- RTU_Loaded --
----------------
Nb_Link : Short_Short_Integer)
is
begin
- -- Simple case: attachement to a one way list
+ -- Simple case: attachment to a one way list
if Nb_Link = 1 then
Obj.Next := L;
-- Dynamically allocated objects: they are attached to a doubly linked
-- list, so that an element can be finalized at any moment by means of
- -- an unchecked deallocation. Attachement is protected against
+ -- an unchecked deallocation. Attachment is protected against
-- multi-threaded access.
elsif Nb_Link = 2 then
raise;
end Locked_Processing;
- -- Attachement of arrays to the final list (used only for objects
+ -- Attachment of arrays to the final list (used only for objects
-- returned by function). Obj, in this case is the last element,
-- but all other elements are already threaded after it. We just
-- attach the rest of the final list at the end of the array list.
end if;
end Attach_To_Final_List;
- ---------------------
- -- Deep_Tag_Adjust --
- ---------------------
-
- procedure Deep_Tag_Adjust
- (L : in out SFR.Finalizable_Ptr;
- A : System.Address;
- B : Short_Short_Integer)
- is
- V : constant SFR.Finalizable_Ptr := To_Finalizable_Ptr (A);
- Controller : constant RC_Ptr := Get_Deep_Controller (A);
-
- begin
- if Controller /= null then
- Adjust (Controller.all);
- Attach_To_Final_List (L, Controller.all, B);
- end if;
-
- -- Is controlled
-
- if V.all in Finalizable then
- Adjust (V.all);
- Attach_To_Final_List (L, Finalizable (V.all), 1);
- end if;
- end Deep_Tag_Adjust;
-
---------------------
-- Deep_Tag_Attach --
----------------------
end if;
end Deep_Tag_Attach;
- -----------------------
- -- Deep_Tag_Finalize --
- -----------------------
-
- procedure Deep_Tag_Finalize
- (L : in out SFR.Finalizable_Ptr;
- A : System.Address;
- B : Boolean)
- is
- pragma Warnings (Off, L);
-
- V : constant SFR.Finalizable_Ptr := To_Finalizable_Ptr (A);
- Controller : constant RC_Ptr := Get_Deep_Controller (A);
-
- begin
- if Controller /= null then
- if B then
- Finalize_One (Controller.all);
- else
- Finalize (Controller.all);
- end if;
- end if;
-
- -- Is controlled
-
- if V.all in Finalizable then
- if B then
- Finalize_One (V.all);
- else
- Finalize (V.all);
- end if;
- end if;
- end Deep_Tag_Finalize;
-
- -------------------------
- -- Deep_Tag_Initialize --
- -------------------------
-
- procedure Deep_Tag_Initialize
- (L : in out SFR.Finalizable_Ptr;
- A : System.Address;
- B : Short_Short_Integer)
- is
- V : constant SFR.Finalizable_Ptr := To_Finalizable_Ptr (A);
- Controller : constant RC_Ptr := Get_Deep_Controller (A);
-
- begin
- -- This procedure should not be called if the object has no
- -- controlled components
-
- if Controller = null then
- raise Program_Error;
-
- -- Has controlled components
-
- else
- Initialize (Controller.all);
- Attach_To_Final_List (L, Controller.all, B);
- end if;
-
- -- Is controlled
-
- if V.all in Finalizable then
- Initialize (V.all);
- Attach_To_Final_List (Controller.F, Finalizable (Controller.all), 1);
- end if;
- end Deep_Tag_Initialize;
-
-----------------------------
-- Detach_From_Final_List --
-----------------------------
-- programs using controlled types heavily.
if System.Restrictions.Abort_Allowed then
- X := To_Ptr (System.Soft_Links.Get_Current_Excep.all).Id;
+ X := To_Ptr (SSL.Get_Current_Excep.all).Id;
end if;
while P /= null loop
Object.My_Address := Object'Address;
end Initialize;
+ ---------------------
+ -- Move_Final_List --
+ ---------------------
+
+ procedure Move_Final_List
+ (From : in out SFR.Finalizable_Ptr;
+ To : Finalizable_Ptr_Ptr)
+ is
+ begin
+ -- This is currently called at the end of the return statement, and the
+ -- caller does NOT defer aborts. We need to defer aborts to prevent
+ -- mangling the finalization lists.
+
+ SSL.Abort_Defer.all;
+
+ -- Put the return statement's finalization list onto the caller's one,
+ -- thus transferring responsibility for finalization of the return
+ -- object to the caller.
+
+ Attach_To_Final_List (To.all, From.all, Nb_Link => 3);
+
+ -- Empty the return statement's finalization list, so that when the
+ -- cleanup code executes, there will be nothing to finalize.
+ From := null;
+
+ SSL.Abort_Undefer.all;
+ end Move_Final_List;
+
-------------------------
-- Raise_From_Finalize --
-------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2006 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
Collection_Finalization_Started : constant SFR.Finalizable_Ptr :=
To_Finalizable_Ptr (SSE.To_Address (1));
- -- This is used to implement the rule in RM-4.8(10.2/2) that requires an
+ -- This is used to implement the rule in RM 4.8(10.2/2) that requires an
-- allocator to raise Program_Error if the collection finalization has
-- already started. See also Ada.Finalization.List_Controller. Finalize on
-- List_Controller first sets the list to Collection_Finalization_Started,
-- to indicate that finalization has started. An allocator will call
-- Attach_To_Final_List, which checks for the special value and raises
- -- Program_Error if appropriate. The value of
- -- Collection_Finalization_Started must be different from 'Access of any
- -- finalizable object, and different from null. See AI-280.
+ -- Program_Error if appropriate. The Collection_Finalization_Started value
+ -- must be different from 'Access of any finalizable object, and different
+ -- from null. See AI-280.
Global_Final_List : SFR.Finalizable_Ptr;
-- This list stores the controlled objects defined in library-level
(L : in out SFR.Finalizable_Ptr;
Obj : in out SFR.Finalizable;
Nb_Link : Short_Short_Integer);
- -- Attach finalizable object Obj to the linked list L. Nb_Link controls
- -- the number of link of the linked_list, and can be either 0 for no
- -- attachement, 1 for simple linked lists or 2 for doubly linked lists
- -- or even 3 for a simple attachement of a whole array of elements.
- -- Attachement to a simply linked list is not protected against
- -- concurrent access and should only be used in contexts where it
- -- doesn't matter, such as for objects allocated on the stack. In the
- -- case of an attachment on a doubly linked list, L must not be null
- -- and Obj will be inserted AFTER the first element and the attachment
- -- is protected against concurrent call. Typically used to attach to
- -- a dynamically allocated object to a List_Controller (whose first
- -- element is always a dummy element)
+ -- Attach finalizable object Obj to the linked list L. Nb_Link controls the
+ -- number of link of the linked_list, and is one of: 0 for no attachment, 1
+ -- for simple linked lists or 2 for doubly linked lists or even 3 for a
+ -- simple attachment of a whole array of elements. Attachment to a simply
+ -- linked list is not protected against concurrent access and should only
+ -- be used in contexts where it doesn't matter, such as for objects
+ -- allocated on the stack. In the case of an attachment on a doubly linked
+ -- list, L must not be null and Obj will be inserted AFTER the first
+ -- element and the attachment is protected against concurrent call.
+ -- Typically used to attach to a dynamically allocated object to a
+ -- List_Controller (whose first element is always a dummy element)
+
+ type Finalizable_Ptr_Ptr is access all SFR.Finalizable_Ptr;
+ -- A pointer to a finalization list. This is used as the type of the extra
+ -- implicit formal which are passed to build-in-place functions that return
+ -- controlled types (see Sem_Ch6). That extra formal is then passed on to
+ -- Move_Final_List (below).
+
+ procedure Move_Final_List
+ (From : in out SFR.Finalizable_Ptr;
+ To : Finalizable_Ptr_Ptr);
+ -- Move all objects on From list to To list. This is used to implement
+ -- build-in-place function returns. The return object is initially placed
+ -- on a finalization list local to the return statement, in case the
+ -- return statement is left prematurely (due to raising an exception,
+ -- being aborted, or a goto or exit statement). Once the return statement
+ -- has completed successfully, Move_Final_List is called to move the
+ -- return object to the caller's finalization list.
procedure Finalize_List (L : SFR.Finalizable_Ptr);
-- Call Finalize on each element of the list L;
procedure Finalize_One (Obj : in out SFR.Finalizable);
- -- Call Finalize on Obj and remove its final list.
+ -- Call Finalize on Obj and remove its final list
---------------------
-- Deep Procedures --
---------------------
- procedure Deep_Tag_Initialize
- (L : in out SFR.Finalizable_Ptr;
- A : System.Address;
- B : Short_Short_Integer);
- -- Generic initialize for tagged objects with controlled components.
- -- A is the address of the object, L the finalization list when it needs
- -- to be attached and B the attachement level (see Attach_To_Final_List).
-
- procedure Deep_Tag_Adjust
- (L : in out SFR.Finalizable_Ptr;
- A : System.Address;
- B : Short_Short_Integer);
- -- Generic adjust for tagged objects with controlled components.
- -- A is the address of the object, L the finalization list when it needs
- -- to be attached and B the attachement level (see Attach_To_Final_List).
-
- procedure Deep_Tag_Finalize
- (L : in out SFR.Finalizable_Ptr;
- A : System.Address;
- B : Boolean);
- -- Generic finalize for tagged objects with controlled components.
- -- A is the address of the object, L the finalization list when it needs
- -- to be attached and B the attachement level (see Attach_To_Final_List).
-
procedure Deep_Tag_Attach
(L : in out SFR.Finalizable_Ptr;
A : System.Address;
B : Short_Short_Integer);
- -- Generic attachement for tagged objects with controlled components.
+ -- Generic attachment for tagged objects with controlled components.
-- A is the address of the object, L the finalization list when it needs
- -- to be attached and B the attachement level (see Attach_To_Final_List).
+ -- to be attached and B the attachment level (see Attach_To_Final_List).
-----------------------------
-- Record Controller Types --
end record;
procedure Initialize (Object : in out Limited_Record_Controller);
- -- Does nothing.
+ -- Does nothing currently.
procedure Finalize (Object : in out Limited_Record_Controller);
- -- Finalize the controlled components of the enclosing record by
- -- following the list starting at Object.F.
+ -- Finalize the controlled components of the enclosing record by following
+ -- the list starting at Object.F.
type Record_Controller is
new Limited_Record_Controller with record
-- Initialize the field My_Address to the Object'Address
procedure Adjust (Object : in out Record_Controller);
- -- Adjust the components and their finalization pointers by subtracting
- -- by the offset of the target and the source addresses of the assignment.
+ -- Adjust the components and their finalization pointers by subtracting by
+ -- the offset of the target and the source addresses of the assignment.
-- Inherit Finalize from Limited_Record_Controller
procedure Detach_From_Final_List (Obj : in out SFR.Finalizable);
- -- Remove the specified object from its Final list, which must be a
- -- doubly linked list.
+ -- Remove the specified object from its Final list, which must be a doubly
+ -- linked list.
end System.Finalization_Implementation;
------------------------------------
type Activation_Chain is limited private;
- -- Comment required ???
+ -- Linked list of to-be-activated tasks, linked through
+ -- Activation_Link. The order of tasks on the list is irrelevant, because
+ -- the priority rules will ensure that they actually start activating in
+ -- priority order.
type Activation_Chain_Access is access all Activation_Chain;
- -- Comment required ???
type Task_Procedure_Access is access procedure (Arg : System.Address);
-- Normally, a task starts out with internal master nesting level one
-- larger than external master nesting level. It is incremented to one by
-- Enter_Master, which is called in the task body only if the compiler
- -- thinks the task may have dependent tasks. It is set to for the
+ -- thinks the task may have dependent tasks. It is set to 1 for the
-- environment task, the level 2 is reserved for server tasks of the
-- run-time system (the so called "independent tasks"), and the level 3 is
- -- for the library level tasks.
+ -- for the library level tasks. Foreign threads which are detected by
+ -- the run-time have a level of 0, allowing these tasks to be easily
+ -- distinguished if needed.
+ Foreign_Task_Level : constant Master_Level := 0;
Environment_Task_Level : constant Master_Level := 1;
Independent_Task_Level : constant Master_Level := 2;
Library_Task_Level : constant Master_Level := 3;
private
Null_Task : constant Task_Id := null;
- type Activation_Chain is record
+ type Activation_Chain is limited record
T_ID : Task_Id;
end record;
- pragma Volatile (Activation_Chain);
- -- Activation_chain is an in-out parameter of initialization procedures
- -- and it must be passed by reference because the init proc may terminate
+ -- Activation_Chain is an in-out parameter of initialization procedures and
+ -- it must be passed by reference because the init proc may terminate
-- abnormally after creating task components, and these must be properly
- -- registered for removal (Expunge_Unactivated_Tasks).
+ -- registered for removal (Expunge_Unactivated_Tasks). The "limited" forces
+ -- Activation_Chain to be a by-reference type; see RM-6.2(4).
end System.Tasking;
-- trigger an automatic stack alignment suitable for GCC's assumptions if
-- need be.
+ -- "Vulnerable_..." in the procedure names below means they must be called
+ -- with abort deferred.
+
procedure Vulnerable_Complete_Task (Self_ID : Task_Id);
-- Complete the calling task. This procedure must be called with
-- abort deferred. It should only be called by Complete_Task and
begin
-- If Master is greater than the current master, it means that Master
-- has already awaited its dependent tasks. This raises Program_Error,
- -- by 4.8(10.3/2). See AI-280.
+ -- by 4.8(10.3/2). See AI-280. Ignore this check for foreign threads.
- if Master > Self_ID.Master_Within then
+ if Self_ID.Master_of_Task /= Foreign_Task_Level
+ and then Master > Self_ID.Master_Within
+ then
raise Program_Error with
"create task after awaiting termination";
end if;
end if;
end Free_Task;
+ ---------------------------
+ -- Move_Activation_Chain --
+ ---------------------------
+
+ procedure Move_Activation_Chain
+ (From, To : Activation_Chain_Access;
+ New_Master : Master_ID)
+ is
+ Self_ID : constant Task_Id := STPO.Self;
+ C : Task_Id;
+
+ begin
+ pragma Debug
+ (Debug.Trace (Self_ID, "Move_Activation_Chain", 'C'));
+
+ -- Nothing to do if From is empty, and we can check that without
+ -- deferring aborts.
+
+ C := From.all.T_ID;
+
+ if C = null then
+ return;
+ end if;
+
+ Initialization.Defer_Abort (Self_ID);
+
+ -- Loop through the From chain, changing their Master_of_Task
+ -- fields, and to find the end of the chain.
+
+ loop
+ C.Master_of_Task := New_Master;
+ exit when C.Common.Activation_Link = null;
+ C := C.Common.Activation_Link;
+ end loop;
+
+ -- Hook From in at the start of To
+
+ C.Common.Activation_Link := To.all.T_ID;
+ To.all.T_ID := From.all.T_ID;
+
+ -- Set From to empty
+
+ From.all.T_ID := null;
+
+ Initialization.Undefer_Abort (Self_ID);
+ end Move_Activation_Chain;
+
------------------
-- Task_Wrapper --
------------------
C := All_Tasks_List;
while C /= null loop
- if C.Common.Activator = Self_ID then
+ if C.Common.Activator = Self_ID and then C.Master_of_Task = CM then
return False;
end if;
-- zero for new tasks, and the task should not exit the
-- sleep-loops that use this count until the count reaches zero.
+ -- While we're counting, if we run across any unactivated tasks that
+ -- belong to this master, we summarily terminate them as required by
+ -- RM-9.2(6).
+
Lock_RTS;
Write_Lock (Self_ID);
C := All_Tasks_List;
while C /= null loop
- if C.Common.Activator = Self_ID then
+
+ -- Terminate unactivated (never-to-be activated) tasks
+
+ if C.Common.Activator = Self_ID and then C.Master_of_Task = CM then
pragma Assert (C.Common.State = Unactivated);
+ -- Usually, C.Common.Activator = Self_ID implies C.Master_of_Task
+ -- = CM. The only case where C is pending activation by this
+ -- task, but the master of C is not CM is in Ada 2005, when C is
+ -- part of a return object of a build-in-place function.
Write_Lock (C);
C.Common.Activator := null;
Unlock (C);
end if;
+ -- Count it if dependent on this master
+
if C.Common.Parent = Self_ID and then C.Master_of_Task = CM then
Write_Lock (C);
-- Complete the calling task
- -- This procedure must be called with abort deferred. (That's why the
- -- name has "Vulnerable" in it.) It should only be called by Complete_Task
- -- and Finalize_Global_Tasks (for the environment task).
+ -- This procedure must be called with abort deferred. It should only be
+ -- called by Complete_Task and Finalize_Global_Tasks (for the environment
+ -- task).
-- The effect is similar to that of Complete_Master. Differences include
-- the closing of entries here, and computation of the number of active
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- it is not needed if priority-based scheduling is supported, since all
-- the activated tasks synchronize on the activators lock before they
-- start activating and so they should start activating in priority order.
+ -- ??? Actually, the body of this package DOES reverse the chain, so I
+ -- don't understand the above comment.
procedure Complete_Activation;
-- Compiler interface only. Do not call from within the RTS.
-- if T has terminated. Do nothing in the other case. It is called from
-- Unchecked_Deallocation, for objects that are or contain tasks.
+ procedure Move_Activation_Chain
+ (From, To : Activation_Chain_Access;
+ New_Master : Master_ID);
+ -- Compiler interface only. Do not call from within the RTS.
+ -- Move all tasks on From list to To list, and change their Master_of_Task
+ -- to be New_Master. This is used to implement build-in-place function
+ -- returns. Tasks that are part of the return object are initially placed
+ -- on an activation chain local to the return statement, and their master
+ -- is the return statement, in case the return statement is left
+ -- prematurely (due to raising an exception, being aborted, or a goto or
+ -- exit statement). Once the return statement has completed successfully,
+ -- Move_Activation_Chain is called to move them to the caller's activation
+ -- chain, and change their master to the one passed in by the caller. If
+ -- that doesn't happen, they will never be activated, and will become
+ -- terminated on leaving the return statement.
+
function Terminated (T : Task_Id) return Boolean;
-- This is called by the compiler to implement the 'Terminated attribute.
-- Though is not required to be so by the ARM, we choose to synchronize
-- If proper warnings are enabled and the subprogram contains a construct
-- that cannot be inlined, the offending construct is flagged accordingly.
- type Conformance_Type is
- (Type_Conformant, Mode_Conformant, Subtype_Conformant, Fully_Conformant);
- -- Conformance type used for following call, meaning matches the
- -- RM definitions of the corresponding terms.
-
procedure Check_Conformance
(New_Id : Entity_Id;
Old_Id : Entity_Id;
-- True otherwise. Proc is the entity for the procedure case and is used
-- in posting the warning message.
- function Conforming_Types
- (T1 : Entity_Id;
- T2 : Entity_Id;
- Ctype : Conformance_Type;
- Get_Inst : Boolean := False) return Boolean;
- -- Check that two formal parameter types conform, checking both for
- -- equality of base types, and where required statically matching
- -- subtypes, depending on the setting of Ctype.
-
procedure Enter_Overloaded_Entity (S : Entity_Id);
-- This procedure makes S, a new overloaded entity, into the first visible
-- entity with that name.
begin
Generate_Definition (Designator);
- Set_Is_Abstract (Designator);
+ Set_Is_Abstract_Subprogram (Designator);
New_Overloaded_Entity (Designator);
Check_Delayed_Subprogram (Designator);
end;
end if;
- -- ???Check for not-yet-implemented cases of AI-318. Currently we
- -- warn, because that's convenient for our own use. We might want to
- -- change these warnings to errors at some point. This will go away
- -- once AI-318 is fully implemented.
- --
- -- In the first version, we plan not to implement limited function
- -- returns when the result type contains tasks or protected objects,
- -- and when the result subtype is unconstrained.
-
- if Ada_Version >= Ada_05
- and then not Debug_Flag_Dot_L
- and then Is_Inherently_Limited_Type (R_Type)
- then
- if Has_Task (R_Type) then
- Error_Msg_N ("(Ada 2005) return of task objects" &
- " is not yet implemented", N);
- end if;
-
- if Is_Controlled (R_Type)
- or else Has_Controlled_Component (R_Type)
- then
- Error_Msg_N
- ("(Ada 2005) return of limited controlled objects" &
- " is not yet implemented", N);
- end if;
-
- if
- Is_Composite_Type (R_Type) and then not Is_Constrained (R_Type)
- then
- Error_Msg_N
- ("(Ada 2005) return of unconstrained limited composite objects" &
- " is not yet implemented", N);
- end if;
- end if;
-
if Present (Expr)
and then Present (Etype (Expr)) -- Could be False in case of errors.
then
-- subprogram declaration for it, in order to attach the body to inline.
procedure Copy_Parameter_List (Plist : List_Id);
- -- Comment required ???
+ -- Utility to create a parameter profile for a new subprogram spec,
+ -- when the subprogram has a body that acts as spec. This is done for
+ -- some cases of inlining, and for private protected ops.
procedure Verify_Overriding_Indicator;
-- If there was a previous spec, the entity has been entered in the
Set_Is_Compilation_Unit (Body_Id, Is_Compilation_Unit (Spec_Id));
Set_Is_Child_Unit (Body_Id, Is_Child_Unit (Spec_Id));
- if Is_Abstract (Spec_Id) then
+ if Is_Abstract_Subprogram (Spec_Id) then
Error_Msg_N ("an abstract subprogram cannot have a body", N);
return;
else
(Etype (First_Entity (Spec_Id))));
end if;
- -- Ada 2005: A formal that is an access parameter may have a
- -- designated type imported through a limited_with clause, while
- -- the body has a regular with clause. Update the types of the
- -- formals accordingly, so that the non-limited view of each type
- -- is available in the body. We have already verified that the
- -- declarations are type-conformant.
-
- if Ada_Version >= Ada_05 then
- declare
- F_Spec : Entity_Id;
- F_Body : Entity_Id;
-
- begin
- F_Spec := First_Formal (Spec_Id);
- F_Body := First_Formal (Body_Id);
-
- while Present (F_Spec) loop
- if Ekind (Etype (F_Spec)) = E_Anonymous_Access_Type
- and then
- From_With_Type (Designated_Type (Etype (F_Spec)))
- then
- Set_Etype (F_Spec, Etype (F_Body));
- end if;
-
- Next_Formal (F_Spec);
- Next_Formal (F_Body);
- end loop;
- end;
- end if;
-
-- Now make the formals visible, and place subprogram
-- on scope stack.
end if;
if Is_Interface (Etyp)
- and then not Is_Abstract (Designator)
+ and then not Is_Abstract_Subprogram (Designator)
and then not (Ekind (Designator) = E_Procedure
and then Null_Present (Specification (N)))
then
-- interface types the following error message will be reported later
-- (see Analyze_Subprogram_Declaration).
- if Is_Abstract (Etype (Designator))
+ if Is_Abstract_Type (Etype (Designator))
and then not Is_Interface (Etype (Designator))
and then Nkind (Parent (N))
/= N_Abstract_Subprogram_Declaration
/= N_Formal_Abstract_Subprogram_Declaration
and then (Nkind (Parent (N)) /= N_Subprogram_Renaming_Declaration
or else not Is_Entity_Name (Name (Parent (N)))
- or else not Is_Abstract (Entity (Name (Parent (N)))))
+ or else not Is_Abstract_Subprogram
+ (Entity (Name (Parent (N)))))
then
Error_Msg_N
("function that returns abstract type must be abstract", N);
--------------------------
procedure Build_Body_To_Inline (N : Node_Id; Subp : Entity_Id) is
- Decl : constant Node_Id := Unit_Declaration_Node (Subp);
+ Decl : constant Node_Id := Unit_Declaration_Node (Subp);
Original_Body : Node_Id;
Body_To_Analyze : Node_Id;
Max_Size : constant := 10;
-- elementary statements, as a measure of acceptable size.
function Has_Pending_Instantiation return Boolean;
- -- If some enclosing body contains instantiations that appear before
- -- the corresponding generic body, the enclosing body has a freeze node
- -- so that it can be elaborated after the generic itself. This might
+ -- If some enclosing body contains instantiations that appear before the
+ -- corresponding generic body, the enclosing body has a freeze node so
+ -- that it can be elaborated after the generic itself. This might
-- conflict with subsequent inlinings, so that it is unsafe to try to
-- inline in such a case.
function Has_Single_Return return Boolean;
- -- In general we cannot inline functions that return unconstrained
- -- type. However, we can handle such functions if all return statements
- -- return a local variable that is the only declaration in the body
- -- of the function. In that case the call can be replaced by that
- -- local variable as is done for other inlined calls.
+ -- In general we cannot inline functions that return unconstrained type.
+ -- However, we can handle such functions if all return statements return
+ -- a local variable that is the only declaration in the body of the
+ -- function. In that case the call can be replaced by that local
+ -- variable as is done for other inlined calls.
procedure Remove_Pragmas;
- -- A pragma Unreferenced that mentions a formal parameter has no
- -- meaning when the body is inlined and the formals are rewritten.
- -- Remove it from body to inline. The analysis of the non-inlined body
- -- will handle the pragma properly.
+ -- A pragma Unreferenced that mentions a formal parameter has no meaning
+ -- when the body is inlined and the formals are rewritten. Remove it
+ -- from body to inline. The analysis of the non-inlined body will handle
+ -- the pragma properly.
function Uses_Secondary_Stack (Bod : Node_Id) return Boolean;
-- If the body of the subprogram includes a call that returns an
-- are left by an erroneous overriding.
if not Is_Predefined_Dispatching_Operation (Prim_Op)
- and then not Is_Abstract (Prim_Op)
+ and then not Is_Abstract_Subprogram (Prim_Op)
and then Chars (Prim_Op) = Chars (Op)
and then Type_Conformant (Prim_Op, Op)
and then Convention (Prim_Op) /= Convention (Op)
-- of abstract primitives left from an erroneous overriding.
if not Is_Predefined_Dispatching_Operation (Prim_Op)
- and then not Is_Abstract (Prim_Op)
+ and then not Is_Abstract_Subprogram (Prim_Op)
then
Check_Convention
(Op => Prim_Op,
begin
-- Never need to freeze abstract subprogram
- if Is_Abstract (Designator) then
+ if Ekind (Designator) /= E_Subprogram_Type
+ and then Is_Abstract_Subprogram (Designator)
+ then
null;
else
-- Need delayed freeze if return type itself needs a delayed
if Is_Inherently_Limited_Type (Typ) then
Set_Returns_By_Ref (Designator);
- elsif Present (Utyp) and then Controlled_Type (Utyp) then
+ elsif Present (Utyp) and then CW_Or_Controlled_Type (Utyp) then
Set_Returns_By_Ref (Designator);
end if;
end;
if Nkind (Decl) = N_Subprogram_Body
or else Nkind (Decl) = N_Subprogram_Body_Stub
or else Nkind (Decl) = N_Subprogram_Declaration
+ or else Nkind (Decl) = N_Abstract_Subprogram_Declaration
or else Nkind (Decl) = N_Subprogram_Renaming_Declaration
then
Spec := Specification (Decl);
if Ekind (Subp) = E_Entry then
Error_Msg_NE ("entry & overrides inherited operation #",
Spec, Subp);
+
else
Error_Msg_NE ("subprogram & overrides inherited operation #",
Spec, Subp);
end if;
end if;
+
+ -- If Subp is an operator, it may override a predefined operation.
+ -- In that case overridden_subp is empty because of our implicit
+ -- representation for predefined operators. We have to check whether
+ -- the signature of Subp matches that of a predefined operator.
+ -- Note that first argument provides the name of the operator, and
+ -- the second argument the signature that may match that of a standard
+ -- operation.
+
+ elsif Nkind (Subp) = N_Defining_Operator_Symbol
+ and then Must_Not_Override (Spec)
+ then
+ if Operator_Matches_Spec (Subp, Subp) then
+ Error_Msg_NE
+ ("subprogram & overrides predefined operation ",
+ Spec, Subp);
+ end if;
+
else
if Must_Override (Spec) then
if Ekind (Subp) = E_Entry then
Error_Msg_NE ("entry & is not overriding", Spec, Subp);
+
+ elsif Nkind (Subp) = N_Defining_Operator_Symbol then
+ if not Operator_Matches_Spec (Subp, Subp) then
+ Error_Msg_NE
+ ("subprogram & is not overriding", Spec, Subp);
+ end if;
+
else
Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
end if;
declare
Arg : constant Node_Id :=
Original_Node (First_Actual (Last_Stm));
-
begin
if Nkind (Arg) = N_Attribute_Reference
and then Attribute_Name (Arg) = Name_Identity
-- treated recursively because they carry a signature.
Are_Anonymous_Access_To_Subprogram_Types :=
-
- -- Case 1: Anonymous access to subprogram types
-
- (Ekind (Type_1) = E_Anonymous_Access_Subprogram_Type
- and then Ekind (Type_2) = E_Anonymous_Access_Subprogram_Type)
-
- -- Case 2: Anonymous access to PROTECTED subprogram types. In this
- -- case the anonymous type_declaration has been replaced by an
- -- occurrence of an internal access to subprogram type declaration
- -- available through the Original_Access_Type attribute
-
- or else
- (Ekind (Type_1) = E_Access_Protected_Subprogram_Type
- and then Ekind (Type_2) = E_Access_Protected_Subprogram_Type
- and then not Comes_From_Source (Type_1)
- and then not Comes_From_Source (Type_2)
- and then Present (Original_Access_Type (Type_1))
- and then Present (Original_Access_Type (Type_2))
- and then Ekind (Original_Access_Type (Type_1)) =
- E_Anonymous_Access_Protected_Subprogram_Type
- and then Ekind (Original_Access_Type (Type_2)) =
- E_Anonymous_Access_Protected_Subprogram_Type);
+ Ekind (Type_1) = Ekind (Type_2)
+ and then
+ (Ekind (Type_1) = E_Anonymous_Access_Subprogram_Type
+ or else
+ Ekind (Type_1) = E_Anonymous_Access_Protected_Subprogram_Type);
-- Test anonymous access type case. For this case, static subtype
-- matching is required for mode conformance (RM 6.3.1(15))
EF : constant Entity_Id :=
Make_Defining_Identifier (Sloc (Assoc_Entity),
Chars => New_External_Name (Chars (Assoc_Entity),
- Suffix => Suffix));
+ Suffix => Suffix));
begin
- -- We never generate extra formals if expansion is not active
- -- because we don't need them unless we are generating code.
-
- if not Expander_Active then
- return Empty;
- end if;
-
-- A little optimization. Never generate an extra formal for the
-- _init operand of an initialization procedure, since it could
-- never be used.
-- Start of processing for Create_Extra_Formals
begin
+ -- We never generate extra formals if expansion is not active
+ -- because we don't need them unless we are generating code.
+
+ if not Expander_Active then
+ return;
+ end if;
+
-- If this is a derived subprogram then the subtypes of the parent
-- subprogram's formal parameters will be used to to determine the need
-- for extra formals.
Next_Formal (Formal);
end loop;
- -- If Extra_formals where already created, don't do it again. This
+ -- If Extra_formals were already created, don't do it again. This
-- situation may arise for subprogram types created as part of
-- dispatching calls (see Expand_Dispatching_Call)
end if;
if Has_Discriminants (Formal_Type)
- and then
- ((not Is_Constrained (Formal_Type)
- and then not Is_Indefinite_Subtype (Formal_Type))
- or else Present (Extra_Formal (Formal)))
+ and then not Is_Constrained (Formal_Type)
+ and then not Is_Indefinite_Subtype (Formal_Type)
then
Set_Extra_Constrained
(Formal,
-- Create extra formal for supporting accessibility checking
-- This is suppressed if we specifically suppress accessibility
- -- checks at the pacage level for either the subprogram, or the
+ -- checks at the package level for either the subprogram, or the
-- package in which it resides. However, we do not suppress it
-- simply if the scope has accessibility checks suppressed, since
-- this could cause trouble when clients are compiled with a
end if;
end if;
- if Present (P_Formal) then
- Next_Formal (P_Formal);
- end if;
-
-- This label is required when skipping extra formal generation for
-- Unchecked_Union parameters.
<<Skip_Extra_Formal_Generation>>
+ if Present (P_Formal) then
+ Next_Formal (P_Formal);
+ end if;
+
Next_Formal (Formal);
end loop;
-- Ada 2005 (AI-318-02): In the case of build-in-place functions, add
- -- an extra formal that will be passed the address of the return object
- -- within the caller. This is added as the last extra formal, but
- -- eventually will be accompanied by other implicit formals related to
- -- build-in-place functions (such as allocate/deallocate subprograms,
- -- finalization list, constrained flag, task master, task activation
- -- list, etc.).
-
- if Expander_Active
- and then Ada_Version >= Ada_05
- and then Is_Build_In_Place_Function (E)
- then
+ -- appropriate extra formals. See type Exp_Ch6.BIP_Formal_Kind.
+
+ if Ada_Version >= Ada_05 and then Is_Build_In_Place_Function (E) then
declare
- Formal_Type : constant Entity_Id :=
- Create_Itype
- (E_Anonymous_Access_Type,
- E, Scope_Id => Scope (E));
- Result_Subt : constant Entity_Id := Etype (E);
- Result_Addr_Formal : Entity_Id;
+ Result_Subt : constant Entity_Id := Etype (E);
+
+ Discard : Entity_Id;
+ pragma Warnings (Off, Discard);
begin
- Set_Directly_Designated_Type (Formal_Type, Result_Subt);
- Set_Etype (Formal_Type, Formal_Type);
- Init_Size_Align (Formal_Type);
- Set_Depends_On_Private
- (Formal_Type, Has_Private_Component (Formal_Type));
- Set_Is_Public (Formal_Type, Is_Public (Scope (Formal_Type)));
- Set_Is_Access_Constant (Formal_Type, False);
- Set_Can_Never_Be_Null (Formal_Type);
+ -- In the case of functions with unconstrained result subtypes,
+ -- add a 3-state formal indicating whether the return object is
+ -- allocated by the caller (0), or should be allocated by the
+ -- callee on the secondary stack (1) or in the global heap (2).
+ -- For the moment we just use Natural for the type of this formal.
+ -- Note that this formal isn't needed in the case where the
+ -- result subtype is constrained.
+
+ if not Is_Constrained (Result_Subt) then
+ Discard :=
+ Add_Extra_Formal
+ (E, Standard_Natural,
+ E, BIP_Formal_Suffix (BIP_Alloc_Form));
+ end if;
- -- Ada 2005 (AI-50217): Propagate the attribute that indicates
- -- the designated type comes from the limited view (for back-end
- -- purposes).
+ -- In the case of functions whose result type has controlled
+ -- parts, we have an extra formal of type
+ -- System.Finalization_Implementation.Finalizable_Ptr_Ptr. That
+ -- is, we are passing a pointer to a finalization list (which is
+ -- itself a pointer). This extra formal is then passed along to
+ -- Move_Final_List in case of successful completion of a return
+ -- statement. We cannot pass an 'in out' parameter, because we
+ -- need to update the finalization list during an abort-deferred
+ -- region, rather than using copy-back after the function
+ -- returns. This is true even if we are able to get away with
+ -- having 'in out' parameters, which are normally illegal for
+ -- functions.
+
+ if Is_Controlled (Result_Subt)
+ or else Has_Controlled_Component (Result_Subt)
+ then
+ Discard :=
+ Add_Extra_Formal
+ (E, RTE (RE_Finalizable_Ptr_Ptr),
+ E, BIP_Formal_Suffix (BIP_Final_List));
+ end if;
+
+ -- If the result type contains tasks, we have two extra formals:
+ -- the master of the tasks to be created, and the caller's
+ -- activation chain.
+
+ if Has_Task (Result_Subt) then
+ Discard :=
+ Add_Extra_Formal
+ (E, RTE (RE_Master_Id),
+ E, BIP_Formal_Suffix (BIP_Master));
+ Discard :=
+ Add_Extra_Formal
+ (E, RTE (RE_Activation_Chain_Access),
+ E, BIP_Formal_Suffix (BIP_Activation_Chain));
+ end if;
- Set_From_With_Type (Formal_Type, From_With_Type (Result_Subt));
+ -- All build-in-place functions get an extra formal that will be
+ -- passed the address of the return object within the caller.
- Layout_Type (Formal_Type);
+ declare
+ Formal_Type : constant Entity_Id :=
+ Create_Itype
+ (E_Anonymous_Access_Type, E,
+ Scope_Id => Scope (E));
+ begin
+ Set_Directly_Designated_Type (Formal_Type, Result_Subt);
+ Set_Etype (Formal_Type, Formal_Type);
+ Init_Size_Align (Formal_Type);
+ Set_Depends_On_Private
+ (Formal_Type, Has_Private_Component (Formal_Type));
+ Set_Is_Public (Formal_Type, Is_Public (Scope (Formal_Type)));
+ Set_Is_Access_Constant (Formal_Type, False);
- Result_Addr_Formal := Add_Extra_Formal (E, Formal_Type, E, "RA");
+ -- Ada 2005 (AI-50217): Propagate the attribute that indicates
+ -- the designated type comes from the limited view (for
+ -- back-end purposes).
- -- For some reason the following is not effective and the
- -- dereference of the formal within the function still gets
- -- a check. ???
+ Set_From_With_Type (Formal_Type, From_With_Type (Result_Subt));
- Set_Can_Never_Be_Null (Result_Addr_Formal);
+ Layout_Type (Formal_Type);
+
+ Discard :=
+ Add_Extra_Formal
+ (E, Formal_Type, E, BIP_Formal_Suffix (BIP_Object_Access));
+ end;
end;
end if;
end Create_Extra_Formals;
-- Warn unless genuine overloading
- if (not Is_Overloadable (E))
- or else Subtype_Conformant (E, S)
+ if (not Is_Overloadable (E) or else Subtype_Conformant (E, S))
+ and then (Is_Immediately_Visible (E)
+ or else
+ Is_Potentially_Use_Visible (S))
then
Error_Msg_Sloc := Sloc (E);
Error_Msg_N ("declaration of & hides one#?", S);
Remove (Decl);
Set_Has_Completion (Op_Name);
Set_Corresponding_Equality (Op_Name, S);
- Set_Is_Abstract (Op_Name, Is_Abstract (S));
+ Set_Is_Abstract_Subprogram (Op_Name, Is_Abstract_Subprogram (S));
end;
end Make_Inequality_Operator;
-- declarations because they don't have interface lists.
if Nkind (Parent (Typ)) /= N_Full_Type_Declaration then
- Collect_Synchronized_Interfaces (Typ, Ifaces_List);
+ Collect_Abstract_Interfaces (Typ, Ifaces_List);
if not Is_Empty_Elmt_List (Ifaces_List) then
Overridden_Subp :=
and then Visible_Part_Type (T)
and then not In_Instance
then
- if Is_Abstract (T)
- and then Is_Abstract (S)
- and then (not Is_Overriding or else not Is_Abstract (E))
+ if Is_Abstract_Type (T)
+ and then Is_Abstract_Subprogram (S)
+ and then (not Is_Overriding
+ or else not Is_Abstract_Subprogram (E))
then
- if not Is_Interface (T) then
- Error_Msg_N ("abstract subprograms must be visible "
+ Error_Msg_N ("abstract subprograms must be visible "
& "('R'M 3.9.3(10))!", S);
- -- Ada 2005 (AI-251)
-
- else
- Error_Msg_N ("primitive subprograms of interface types "
- & "declared in a visible part, must be declared in "
- & "the visible part ('R'M 3.9.4)!", S);
- end if;
-
elsif Ekind (S) = E_Function
and then Is_Tagged_Type (T)
and then T = Base_Type (Etype (S))
Formal_Type :=
Access_Definition (Related_Nod, Parameter_Type (Param_Spec));
+ -- No need to continue if we already notified errors
+
+ if not Present (Formal_Type) then
+ return;
+ end if;
+
-- Ada 2005 (AI-254)
declare
if Present (AD) and then Protected_Present (AD) then
Formal_Type :=
Replace_Anonymous_Access_To_Protected_Subprogram
- (Param_Spec, Formal_Type);
+ (Param_Spec);
end if;
end;
end if;
with Types; use Types;
package Sem_Ch6 is
+ type Conformance_Type is
+ (Type_Conformant, Mode_Conformant, Subtype_Conformant, Fully_Conformant);
+ -- Conformance type used in conformance checks between specs and bodies,
+ -- and for overriding. The literals match the RM definitions of the
+ -- corresponding terms.
+
procedure Analyze_Abstract_Subprogram_Declaration (N : Node_Id);
procedure Analyze_Extended_Return_Statement (N : Node_Id);
procedure Analyze_Function_Call (N : Node_Id);
function Analyze_Subprogram_Specification (N : Node_Id) return Entity_Id;
-- Analyze subprogram specification in both subprogram declarations
- -- and body declarations. Returns the defining entity for the spec.
+ -- and body declarations. Returns the defining entity for the
+ -- specification N.
procedure Cannot_Inline (Msg : String; N : Node_Id; Subp : Entity_Id);
-- This procedure is called if the node N, an instance of a call to
-- their respective counterparts.
procedure Check_Delayed_Subprogram (Designator : Entity_Id);
- -- Designator can be a E_Subrpgram_Type, E_Procedure or E_Function. If a
+ -- Designator can be a E_Subprogram_Type, E_Procedure or E_Function. If a
-- type in its profile depends on a private type without a full
- -- declaration, indicate that the subprogram is delayed.
+ -- declaration, indicate that the subprogram or type is delayed.
procedure Check_Discriminant_Conformance
(N : Node_Id;
-- the flag being placed on the Err_Loc node if it is specified, and
-- on the appropriate component of the New_Id construct if not.
+ function Conforming_Types
+ (T1 : Entity_Id;
+ T2 : Entity_Id;
+ Ctype : Conformance_Type;
+ Get_Inst : Boolean := False) return Boolean;
+ -- Check that the types of two formal parameters are conforming. In most
+ -- cases this is just a name comparison, but within an instance it involves
+ -- generic actual types, and in the presence of anonymous access types
+ -- it must examine the designated types.
+
procedure Create_Extra_Formals (E : Entity_Id);
-- For each parameter of a subprogram or entry that requires an additional
-- formal (such as for access parameters and indefinite discriminated
projects / gcc.git / commitdiff