Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/einfo.adb @ 131:84e7813d76e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
4 -- -- 4 -- --
5 -- E I N F O -- 5 -- E I N F O --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- -- 12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- 13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
68 -- The following fields are present in all entities 68 -- The following fields are present in all entities
69 69
70 -- Homonym Node4 70 -- Homonym Node4
71 -- First_Rep_Item Node6 71 -- First_Rep_Item Node6
72 -- Freeze_Node Node7 72 -- Freeze_Node Node7
73 -- Prev_Entity Node36
73 -- Associated_Entity Node37 74 -- Associated_Entity Node37
74 75
75 -- The usage of other fields (and the entity kinds to which it applies) 76 -- The usage of other fields (and the entity kinds to which it applies)
76 -- depends on the particular field (see Einfo spec for details). 77 -- depends on the particular field (see Einfo spec for details).
77 78
115 -- RM_Size Uint13 116 -- RM_Size Uint13
116 117
117 -- Alignment Uint14 118 -- Alignment Uint14
118 -- Normalized_Position Uint14 119 -- Normalized_Position Uint14
119 -- Postconditions_Proc Node14 120 -- Postconditions_Proc Node14
120 -- Shadow_Entities List14
121 121
122 -- Discriminant_Number Uint15 122 -- Discriminant_Number Uint15
123 -- DT_Position Uint15 123 -- DT_Position Uint15
124 -- DT_Entry_Count Uint15 124 -- DT_Entry_Count Uint15
125 -- Entry_Parameters_Type Node15 125 -- Entry_Parameters_Type Node15
196 -- Associated_Storage_Pool Node22 196 -- Associated_Storage_Pool Node22
197 -- Component_Size Uint22 197 -- Component_Size Uint22
198 -- Corresponding_Remote_Type Node22 198 -- Corresponding_Remote_Type Node22
199 -- Enumeration_Rep_Expr Node22 199 -- Enumeration_Rep_Expr Node22
200 -- Original_Record_Component Node22 200 -- Original_Record_Component Node22
201 -- Private_View Node22
202 -- Protected_Formal Node22 201 -- Protected_Formal Node22
203 -- Scope_Depth_Value Uint22 202 -- Scope_Depth_Value Uint22
204 -- Shared_Var_Procs_Instance Node22 203 -- Shared_Var_Procs_Instance Node22
205 204
206 -- CR_Discriminant Node23 205 -- CR_Discriminant Node23
251 -- Subprograms_For_Type Elist29 250 -- Subprograms_For_Type Elist29
252 251
253 -- Access_Disp_Table_Elab_Flag Node30 252 -- Access_Disp_Table_Elab_Flag Node30
254 -- Anonymous_Object Node30 253 -- Anonymous_Object Node30
255 -- Corresponding_Equality Node30 254 -- Corresponding_Equality Node30
255 -- Hidden_In_Formal_Instance Elist30
256 -- Last_Aggregate_Assignment Node30 256 -- Last_Aggregate_Assignment Node30
257 -- Static_Initialization Node30 257 -- Static_Initialization Node30
258 258
259 -- Activation_Record_Component Node31
259 -- Derived_Type_Link Node31 260 -- Derived_Type_Link Node31
260 -- Thunk_Entity Node31 261 -- Thunk_Entity Node31
261 -- Activation_Record_Component Node31
262 262
263 -- Corresponding_Function Node32 263 -- Corresponding_Function Node32
264 -- Corresponding_Procedure Node32 264 -- Corresponding_Procedure Node32
265 -- Encapsulating_State Node32 265 -- Encapsulating_State Node32
266 -- No_Tagged_Streams_Pragma Node32 266 -- No_Tagged_Streams_Pragma Node32
271 271
272 -- Anonymous_Designated_Type Node35 272 -- Anonymous_Designated_Type Node35
273 -- Entry_Max_Queue_Lengths_Array Node35 273 -- Entry_Max_Queue_Lengths_Array Node35
274 -- Import_Pragma Node35 274 -- Import_Pragma Node35
275 275
276 -- Validated_Object Node36 276 -- Validated_Object Node38
277 277 -- Predicated_Parent Node38
278 -- Class_Wide_Clone Node38 278 -- Class_Wide_Clone Node38
279 279
280 -- Protected_Subprogram Node39 280 -- Protected_Subprogram Node39
281 281
282 -- SPARK_Pragma Node40 282 -- SPARK_Pragma Node40
622 -- Body_Needed_For_Inlining Flag299 622 -- Body_Needed_For_Inlining Flag299
623 -- Has_Private_Extension Flag300 623 -- Has_Private_Extension Flag300
624 624
625 -- Ignore_SPARK_Mode_Pragmas Flag301 625 -- Ignore_SPARK_Mode_Pragmas Flag301
626 -- Is_Initial_Condition_Procedure Flag302 626 -- Is_Initial_Condition_Procedure Flag302
627 627 -- Suppress_Elaboration_Warnings Flag303
628 -- (unused) Flag303 628 -- Is_Elaboration_Warnings_OK_Id Flag304
629 -- (unused) Flag304 629 -- Is_Activation_Record Flag305
630 -- (unused) Flag305 630 -- Needs_Activation_Record Flag306
631 -- (unused) Flag306 631 -- Is_Loop_Parameter Flag307
632 -- (unused) Flag307 632
633 -- (unused) Flag308 633 -- (unused) Flag308
634 -- (unused) Flag309 634 -- (unused) Flag309
635 635
636 -- Note: Flag310-317 are defined in atree.ads/adb, but not yet in atree.h 636 -- Note: Flag310-317 are defined in atree.ads/adb, but not yet in atree.h
637 637
1178 function Elaboration_Entity (Id : E) return E is 1178 function Elaboration_Entity (Id : E) return E is
1179 begin 1179 begin
1180 pragma Assert 1180 pragma Assert
1181 (Is_Subprogram (Id) 1181 (Is_Subprogram (Id)
1182 or else 1182 or else
1183 Ekind (Id) = E_Package 1183 Ekind_In (Id, E_Entry, E_Entry_Family, E_Package)
1184 or else 1184 or else
1185 Is_Generic_Unit (Id)); 1185 Is_Generic_Unit (Id));
1186 return Node13 (Id); 1186 return Node13 (Id);
1187 end Elaboration_Entity; 1187 end Elaboration_Entity;
1188 1188
1189 function Elaboration_Entity_Required (Id : E) return B is 1189 function Elaboration_Entity_Required (Id : E) return B is
1190 begin 1190 begin
1191 pragma Assert 1191 pragma Assert
1192 (Is_Subprogram (Id) 1192 (Is_Subprogram (Id)
1193 or else 1193 or else
1194 Ekind (Id) = E_Package 1194 Ekind_In (Id, E_Entry, E_Entry_Family, E_Package)
1195 or else 1195 or else
1196 Is_Generic_Unit (Id)); 1196 Is_Generic_Unit (Id));
1197 return Flag174 (Id); 1197 return Flag174 (Id);
1198 end Elaboration_Entity_Required; 1198 end Elaboration_Entity_Required;
1199 1199
1262 end Contains_Ignored_Ghost_Code; 1262 end Contains_Ignored_Ghost_Code;
1263 1263
1264 function Contract (Id : E) return N is 1264 function Contract (Id : E) return N is
1265 begin 1265 begin
1266 pragma Assert 1266 pragma Assert
1267 (Ekind_In (Id, E_Protected_Type, -- concurrent variants 1267 (Ekind_In (Id, E_Protected_Type, -- concurrent types
1268 E_Task_Body, 1268 E_Task_Body,
1269 E_Task_Type) 1269 E_Task_Type)
1270 or else 1270 or else
1271 Ekind_In (Id, E_Constant, -- object variants 1271 Ekind_In (Id, E_Constant, -- objects
1272 E_Variable) 1272 E_Variable)
1273 or else 1273 or else
1274 Ekind_In (Id, E_Entry, -- overloadable variants 1274 Ekind_In (Id, E_Entry, -- overloadable
1275 E_Entry_Family, 1275 E_Entry_Family,
1276 E_Function, 1276 E_Function,
1277 E_Generic_Function, 1277 E_Generic_Function,
1278 E_Generic_Procedure, 1278 E_Generic_Procedure,
1279 E_Operator, 1279 E_Operator,
1280 E_Procedure, 1280 E_Procedure,
1281 E_Subprogram_Body) 1281 E_Subprogram_Body)
1282 or else 1282 or else
1283 Ekind_In (Id, E_Generic_Package, -- package variants 1283 Ekind_In (Id, E_Generic_Package, -- packages
1284 E_Package, 1284 E_Package,
1285 E_Package_Body) 1285 E_Package_Body)
1286 or else 1286 or else
1287 Ekind (Id) = E_Void); -- special purpose 1287 Ekind (Id) = E_Void); -- special purpose
1288 return Node34 (Id); 1288 return Node34 (Id);
1289 end Contract; 1289 end Contract;
1290 1290
1291 function Contract_Wrapper (Id : E) return E is 1291 function Contract_Wrapper (Id : E) return E is
1292 begin 1292 begin
1563 return Flag261 (Id); 1563 return Flag261 (Id);
1564 end Has_Delayed_Rep_Aspects; 1564 end Has_Delayed_Rep_Aspects;
1565 1565
1566 function Has_Discriminants (Id : E) return B is 1566 function Has_Discriminants (Id : E) return B is
1567 begin 1567 begin
1568 pragma Assert (Nkind (Id) in N_Entity); 1568 pragma Assert (Is_Type (Id));
1569 return Flag5 (Id); 1569 return Flag5 (Id);
1570 end Has_Discriminants; 1570 end Has_Discriminants;
1571 1571
1572 function Has_Dispatch_Table (Id : E) return B is 1572 function Has_Dispatch_Table (Id : E) return B is
1573 begin 1573 begin
1985 begin 1985 begin
1986 pragma Assert (Ekind (Id) = E_Variable); 1986 pragma Assert (Ekind (Id) = E_Variable);
1987 return Node8 (Id); 1987 return Node8 (Id);
1988 end Hiding_Loop_Variable; 1988 end Hiding_Loop_Variable;
1989 1989
1990 function Hidden_In_Formal_Instance (Id : E) return L is
1991 begin
1992 pragma Assert (Ekind (Id) = E_Package);
1993 return Elist30 (Id);
1994 end Hidden_In_Formal_Instance;
1995
1990 function Homonym (Id : E) return E is 1996 function Homonym (Id : E) return E is
1991 begin 1997 begin
1992 return Node4 (Id); 1998 return Node4 (Id);
1993 end Homonym; 1999 end Homonym;
1994 2000
1995 function Ignore_SPARK_Mode_Pragmas (Id : E) return B is 2001 function Ignore_SPARK_Mode_Pragmas (Id : E) return B is
1996 begin 2002 begin
1997 pragma Assert 2003 pragma Assert
1998 (Ekind_In (Id, E_Protected_Body, -- concurrent variants 2004 (Ekind_In (Id, E_Protected_Body, -- concurrent types
1999 E_Protected_Type, 2005 E_Protected_Type,
2000 E_Task_Body, 2006 E_Task_Body,
2001 E_Task_Type) 2007 E_Task_Type)
2002 or else 2008 or else
2003 Ekind_In (Id, E_Entry, -- overloadable variants 2009 Ekind_In (Id, E_Entry, -- overloadable
2004 E_Entry_Family, 2010 E_Entry_Family,
2005 E_Function, 2011 E_Function,
2006 E_Generic_Function, 2012 E_Generic_Function,
2007 E_Generic_Procedure, 2013 E_Generic_Procedure,
2008 E_Operator, 2014 E_Operator,
2009 E_Procedure, 2015 E_Procedure,
2010 E_Subprogram_Body) 2016 E_Subprogram_Body)
2011 or else 2017 or else
2012 Ekind_In (Id, E_Generic_Package, -- package variants 2018 Ekind_In (Id, E_Generic_Package, -- packages
2013 E_Package, 2019 E_Package,
2014 E_Package_Body)); 2020 E_Package_Body));
2015 return Flag301 (Id); 2021 return Flag301 (Id);
2016 end Ignore_SPARK_Mode_Pragmas; 2022 end Ignore_SPARK_Mode_Pragmas;
2017 2023
2087 begin 2093 begin
2088 pragma Assert (Is_Access_Type (Id)); 2094 pragma Assert (Is_Access_Type (Id));
2089 return Flag69 (Id); 2095 return Flag69 (Id);
2090 end Is_Access_Constant; 2096 end Is_Access_Constant;
2091 2097
2098 function Is_Activation_Record (Id : E) return B is
2099 begin
2100 pragma Assert (Ekind (Id) = E_In_Parameter);
2101 return Flag305 (Id);
2102 end Is_Activation_Record;
2103
2092 function Is_Actual_Subtype (Id : E) return B is 2104 function Is_Actual_Subtype (Id : E) return B is
2093 begin 2105 begin
2094 pragma Assert (Is_Type (Id)); 2106 pragma Assert (Is_Type (Id));
2095 return Flag293 (Id); 2107 return Flag293 (Id);
2096 end Is_Actual_Subtype; 2108 end Is_Actual_Subtype;
2242 return Flag6 (Id); 2254 return Flag6 (Id);
2243 end Is_Dispatching_Operation; 2255 end Is_Dispatching_Operation;
2244 2256
2245 function Is_Elaboration_Checks_OK_Id (Id : E) return B is 2257 function Is_Elaboration_Checks_OK_Id (Id : E) return B is
2246 begin 2258 begin
2247 pragma Assert 2259 pragma Assert (Is_Elaboration_Target (Id));
2248 (Ekind_In (Id, E_Constant, E_Variable)
2249 or else Is_Entry (Id)
2250 or else Is_Generic_Unit (Id)
2251 or else Is_Subprogram (Id)
2252 or else Is_Task_Type (Id));
2253 return Flag148 (Id); 2260 return Flag148 (Id);
2254 end Is_Elaboration_Checks_OK_Id; 2261 end Is_Elaboration_Checks_OK_Id;
2262
2263 function Is_Elaboration_Warnings_OK_Id (Id : E) return B is
2264 begin
2265 pragma Assert (Is_Elaboration_Target (Id) or else Ekind (Id) = E_Void);
2266 return Flag304 (Id);
2267 end Is_Elaboration_Warnings_OK_Id;
2255 2268
2256 function Is_Eliminated (Id : E) return B is 2269 function Is_Eliminated (Id : E) return B is
2257 begin 2270 begin
2258 return Flag124 (Id); 2271 return Flag124 (Id);
2259 end Is_Eliminated; 2272 end Is_Eliminated;
2468 function Is_Local_Anonymous_Access (Id : E) return B is 2481 function Is_Local_Anonymous_Access (Id : E) return B is
2469 begin 2482 begin
2470 pragma Assert (Is_Access_Type (Id)); 2483 pragma Assert (Is_Access_Type (Id));
2471 return Flag194 (Id); 2484 return Flag194 (Id);
2472 end Is_Local_Anonymous_Access; 2485 end Is_Local_Anonymous_Access;
2486
2487 function Is_Loop_Parameter (Id : E) return B is
2488 begin
2489 return Flag307 (Id);
2490 end Is_Loop_Parameter;
2473 2491
2474 function Is_Machine_Code_Subprogram (Id : E) return B is 2492 function Is_Machine_Code_Subprogram (Id : E) return B is
2475 begin 2493 begin
2476 pragma Assert (Is_Subprogram (Id)); 2494 pragma Assert (Is_Subprogram (Id));
2477 return Flag137 (Id); 2495 return Flag137 (Id);
2851 function Must_Have_Preelab_Init (Id : E) return B is 2869 function Must_Have_Preelab_Init (Id : E) return B is
2852 begin 2870 begin
2853 pragma Assert (Is_Type (Id)); 2871 pragma Assert (Is_Type (Id));
2854 return Flag208 (Id); 2872 return Flag208 (Id);
2855 end Must_Have_Preelab_Init; 2873 end Must_Have_Preelab_Init;
2874
2875 function Needs_Activation_Record (Id : E) return B is
2876 begin
2877 return Flag306 (Id);
2878 end Needs_Activation_Record;
2856 2879
2857 function Needs_Debug_Info (Id : E) return B is 2880 function Needs_Debug_Info (Id : E) return B is
2858 begin 2881 begin
2859 return Flag147 (Id); 2882 return Flag147 (Id);
2860 end Needs_Debug_Info; 2883 end Needs_Debug_Info;
3062 E_Function, 3085 E_Function,
3063 E_Procedure)); 3086 E_Procedure));
3064 return Node14 (Id); 3087 return Node14 (Id);
3065 end Postconditions_Proc; 3088 end Postconditions_Proc;
3066 3089
3090 function Predicated_Parent (Id : E) return E is
3091 begin
3092 pragma Assert (Ekind_In (Id, E_Array_Subtype,
3093 E_Record_Subtype,
3094 E_Record_Subtype_With_Private));
3095 return Node38 (Id);
3096 end Predicated_Parent;
3097
3067 function Predicates_Ignored (Id : E) return B is 3098 function Predicates_Ignored (Id : E) return B is
3068 begin 3099 begin
3069 pragma Assert (Is_Type (Id)); 3100 pragma Assert (Is_Type (Id));
3070 return Flag288 (Id); 3101 return Flag288 (Id);
3071 end Predicates_Ignored; 3102 end Predicates_Ignored;
3072 3103
3104 function Prev_Entity (Id : E) return E is
3105 begin
3106 return Node36 (Id);
3107 end Prev_Entity;
3108
3073 function Prival (Id : E) return E is 3109 function Prival (Id : E) return E is
3074 begin 3110 begin
3075 pragma Assert (Is_Protected_Component (Id)); 3111 pragma Assert (Is_Protected_Component (Id));
3076 return Node17 (Id); 3112 return Node17 (Id);
3077 end Prival; 3113 end Prival;
3085 function Private_Dependents (Id : E) return L is 3121 function Private_Dependents (Id : E) return L is
3086 begin 3122 begin
3087 pragma Assert (Is_Incomplete_Or_Private_Type (Id)); 3123 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
3088 return Elist18 (Id); 3124 return Elist18 (Id);
3089 end Private_Dependents; 3125 end Private_Dependents;
3090
3091 function Private_View (Id : E) return N is
3092 begin
3093 pragma Assert (Is_Private_Type (Id));
3094 return Node22 (Id);
3095 end Private_View;
3096 3126
3097 function Protected_Body_Subprogram (Id : E) return E is 3127 function Protected_Body_Subprogram (Id : E) return E is
3098 begin 3128 begin
3099 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id)); 3129 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
3100 return Node11 (Id); 3130 return Node11 (Id);
3274 function Sec_Stack_Needed_For_Return (Id : E) return B is 3304 function Sec_Stack_Needed_For_Return (Id : E) return B is
3275 begin 3305 begin
3276 return Flag167 (Id); 3306 return Flag167 (Id);
3277 end Sec_Stack_Needed_For_Return; 3307 end Sec_Stack_Needed_For_Return;
3278 3308
3279 function Shadow_Entities (Id : E) return S is
3280 begin
3281 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
3282 return List14 (Id);
3283 end Shadow_Entities;
3284
3285 function Shared_Var_Procs_Instance (Id : E) return E is 3309 function Shared_Var_Procs_Instance (Id : E) return E is
3286 begin 3310 begin
3287 pragma Assert (Ekind (Id) = E_Variable); 3311 pragma Assert (Ekind (Id) = E_Variable);
3288 return Node22 (Id); 3312 return Node22 (Id);
3289 end Shared_Var_Procs_Instance; 3313 end Shared_Var_Procs_Instance;
3311 end Small_Value; 3335 end Small_Value;
3312 3336
3313 function SPARK_Aux_Pragma (Id : E) return N is 3337 function SPARK_Aux_Pragma (Id : E) return N is
3314 begin 3338 begin
3315 pragma Assert 3339 pragma Assert
3316 (Ekind_In (Id, E_Protected_Type, -- concurrent variants 3340 (Ekind_In (Id, E_Protected_Type, -- concurrent types
3317 E_Task_Type) 3341 E_Task_Type)
3318 or else 3342 or else
3319 Ekind_In (Id, E_Generic_Package, -- package variants 3343 Ekind_In (Id, E_Generic_Package, -- packages
3320 E_Package, 3344 E_Package,
3321 E_Package_Body)); 3345 E_Package_Body));
3322 return Node41 (Id); 3346 return Node41 (Id);
3323 end SPARK_Aux_Pragma; 3347 end SPARK_Aux_Pragma;
3324 3348
3325 function SPARK_Aux_Pragma_Inherited (Id : E) return B is 3349 function SPARK_Aux_Pragma_Inherited (Id : E) return B is
3326 begin 3350 begin
3327 pragma Assert 3351 pragma Assert
3328 (Ekind_In (Id, E_Protected_Type, -- concurrent variants 3352 (Ekind_In (Id, E_Protected_Type, -- concurrent types
3329 E_Task_Type) 3353 E_Task_Type)
3330 or else 3354 or else
3331 Ekind_In (Id, E_Generic_Package, -- package variants 3355 Ekind_In (Id, E_Generic_Package, -- packages
3332 E_Package, 3356 E_Package,
3333 E_Package_Body)); 3357 E_Package_Body));
3334 return Flag266 (Id); 3358 return Flag266 (Id);
3335 end SPARK_Aux_Pragma_Inherited; 3359 end SPARK_Aux_Pragma_Inherited;
3336 3360
3337 function SPARK_Pragma (Id : E) return N is 3361 function SPARK_Pragma (Id : E) return N is
3338 begin 3362 begin
3339 pragma Assert 3363 pragma Assert
3340 (Ekind_In (Id, E_Protected_Body, -- concurrent variants 3364 (Ekind_In (Id, E_Constant, -- objects
3341 E_Protected_Type,
3342 E_Task_Body,
3343 E_Task_Type)
3344 or else
3345 Ekind_In (Id, E_Constant, -- object variants
3346 E_Variable) 3365 E_Variable)
3347 or else 3366 or else
3348 Ekind_In (Id, E_Entry, -- overloadable variants 3367 Ekind_In (Id, E_Abstract_State, -- overloadable
3368 E_Entry,
3349 E_Entry_Family, 3369 E_Entry_Family,
3350 E_Function, 3370 E_Function,
3351 E_Generic_Function, 3371 E_Generic_Function,
3352 E_Generic_Procedure, 3372 E_Generic_Procedure,
3353 E_Operator, 3373 E_Operator,
3354 E_Procedure, 3374 E_Procedure,
3355 E_Subprogram_Body) 3375 E_Subprogram_Body)
3356 or else 3376 or else
3357 Ekind_In (Id, E_Generic_Package, -- package variants 3377 Ekind_In (Id, E_Generic_Package, -- packages
3358 E_Package, 3378 E_Package,
3359 E_Package_Body) 3379 E_Package_Body)
3360 or else 3380 or else
3361 Ekind (Id) = E_Void); -- special purpose 3381 Ekind (Id) = E_Void -- special purpose
3382 or else
3383 Ekind_In (Id, E_Protected_Body, -- types
3384 E_Task_Body)
3385 or else
3386 Is_Type (Id));
3362 return Node40 (Id); 3387 return Node40 (Id);
3363 end SPARK_Pragma; 3388 end SPARK_Pragma;
3364 3389
3365 function SPARK_Pragma_Inherited (Id : E) return B is 3390 function SPARK_Pragma_Inherited (Id : E) return B is
3366 begin 3391 begin
3367 pragma Assert 3392 pragma Assert
3368 (Ekind_In (Id, E_Protected_Body, -- concurrent variants 3393 (Ekind_In (Id, E_Constant, -- objects
3369 E_Protected_Type,
3370 E_Task_Body,
3371 E_Task_Type)
3372 or else
3373 Ekind_In (Id, E_Constant, -- object variants
3374 E_Variable) 3394 E_Variable)
3375 or else 3395 or else
3376 Ekind_In (Id, E_Entry, -- overloadable variants 3396 Ekind_In (Id, E_Abstract_State, -- overloadable
3397 E_Entry,
3377 E_Entry_Family, 3398 E_Entry_Family,
3378 E_Function, 3399 E_Function,
3379 E_Generic_Function, 3400 E_Generic_Function,
3380 E_Generic_Procedure, 3401 E_Generic_Procedure,
3381 E_Operator, 3402 E_Operator,
3382 E_Procedure, 3403 E_Procedure,
3383 E_Subprogram_Body) 3404 E_Subprogram_Body)
3384 or else 3405 or else
3385 Ekind_In (Id, E_Generic_Package, -- package variants 3406 Ekind_In (Id, E_Generic_Package, -- packages
3386 E_Package, 3407 E_Package,
3387 E_Package_Body) 3408 E_Package_Body)
3388 or else 3409 or else
3389 Ekind (Id) = E_Void); -- special purpose 3410 Ekind (Id) = E_Void -- special purpose
3411 or else
3412 Ekind_In (Id, E_Protected_Body, -- types
3413 E_Task_Body)
3414 or else
3415 Is_Type (Id));
3390 return Flag265 (Id); 3416 return Flag265 (Id);
3391 end SPARK_Pragma_Inherited; 3417 end SPARK_Pragma_Inherited;
3392 3418
3393 function Spec_Entity (Id : E) return E is 3419 function Spec_Entity (Id : E) return E is
3394 begin 3420 begin
3484 begin 3510 begin
3485 pragma Assert (Is_Subprogram (Id)); 3511 pragma Assert (Is_Subprogram (Id));
3486 return Uint24 (Id); 3512 return Uint24 (Id);
3487 end Subps_Index; 3513 end Subps_Index;
3488 3514
3515 function Suppress_Elaboration_Warnings (Id : E) return B is
3516 begin
3517 return Flag303 (Id);
3518 end Suppress_Elaboration_Warnings;
3519
3489 function Suppress_Initialization (Id : E) return B is 3520 function Suppress_Initialization (Id : E) return B is
3490 begin 3521 begin
3491 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable); 3522 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
3492 return Flag105 (Id); 3523 return Flag105 (Id);
3493 end Suppress_Initialization; 3524 end Suppress_Initialization;
3559 end Uses_Sec_Stack; 3590 end Uses_Sec_Stack;
3560 3591
3561 function Validated_Object (Id : E) return N is 3592 function Validated_Object (Id : E) return N is
3562 begin 3593 begin
3563 pragma Assert (Ekind (Id) = E_Variable); 3594 pragma Assert (Ekind (Id) = E_Variable);
3564 return Node36 (Id); 3595 return Node38 (Id);
3565 end Validated_Object; 3596 end Validated_Object;
3566 3597
3567 function Warnings_Off (Id : E) return B is 3598 function Warnings_Off (Id : E) return B is
3568 begin 3599 begin
3569 return Flag96 (Id); 3600 return Flag96 (Id);
4081 end Set_Contains_Ignored_Ghost_Code; 4112 end Set_Contains_Ignored_Ghost_Code;
4082 4113
4083 procedure Set_Contract (Id : E; V : N) is 4114 procedure Set_Contract (Id : E; V : N) is
4084 begin 4115 begin
4085 pragma Assert 4116 pragma Assert
4086 (Ekind_In (Id, E_Protected_Type, -- concurrent variants 4117 (Ekind_In (Id, E_Protected_Type, -- concurrent types
4087 E_Task_Body, 4118 E_Task_Body,
4088 E_Task_Type) 4119 E_Task_Type)
4089 or else 4120 or else
4090 Ekind_In (Id, E_Constant, -- object variants 4121 Ekind_In (Id, E_Constant, -- objects
4091 E_Variable) 4122 E_Variable)
4092 or else 4123 or else
4093 Ekind_In (Id, E_Entry, -- overloadable variants 4124 Ekind_In (Id, E_Entry, -- overloadable
4094 E_Entry_Family, 4125 E_Entry_Family,
4095 E_Function, 4126 E_Function,
4096 E_Generic_Function, 4127 E_Generic_Function,
4097 E_Generic_Procedure, 4128 E_Generic_Procedure,
4098 E_Operator, 4129 E_Operator,
4099 E_Procedure, 4130 E_Procedure,
4100 E_Subprogram_Body) 4131 E_Subprogram_Body)
4101 or else 4132 or else
4102 Ekind_In (Id, E_Generic_Package, -- package variants 4133 Ekind_In (Id, E_Generic_Package, -- packages
4103 E_Package, 4134 E_Package,
4104 E_Package_Body) 4135 E_Package_Body)
4105 or else 4136 or else
4106 Ekind (Id) = E_Void); -- special purpose 4137 Ekind (Id) = E_Void); -- special purpose
4107 Set_Node34 (Id, V); 4138 Set_Node34 (Id, V);
4108 end Set_Contract; 4139 end Set_Contract;
4109 4140
4110 procedure Set_Contract_Wrapper (Id : E; V : E) is 4141 procedure Set_Contract_Wrapper (Id : E; V : E) is
4111 begin 4142 begin
4365 procedure Set_Elaboration_Entity (Id : E; V : E) is 4396 procedure Set_Elaboration_Entity (Id : E; V : E) is
4366 begin 4397 begin
4367 pragma Assert 4398 pragma Assert
4368 (Is_Subprogram (Id) 4399 (Is_Subprogram (Id)
4369 or else 4400 or else
4370 Ekind (Id) = E_Package 4401 Ekind_In (Id, E_Entry, E_Entry_Family, E_Package)
4371 or else 4402 or else
4372 Is_Generic_Unit (Id)); 4403 Is_Generic_Unit (Id));
4373 Set_Node13 (Id, V); 4404 Set_Node13 (Id, V);
4374 end Set_Elaboration_Entity; 4405 end Set_Elaboration_Entity;
4375 4406
4376 procedure Set_Elaboration_Entity_Required (Id : E; V : B := True) is 4407 procedure Set_Elaboration_Entity_Required (Id : E; V : B := True) is
4377 begin 4408 begin
4378 pragma Assert 4409 pragma Assert
4379 (Is_Subprogram (Id) 4410 (Is_Subprogram (Id)
4380 or else 4411 or else
4381 Ekind (Id) = E_Package 4412 Ekind_In (Id, E_Entry, E_Entry_Family, E_Package)
4382 or else 4413 or else
4383 Is_Generic_Unit (Id)); 4414 Is_Generic_Unit (Id));
4384 Set_Flag174 (Id, V); 4415 Set_Flag174 (Id, V);
4385 end Set_Elaboration_Entity_Required; 4416 end Set_Elaboration_Entity_Required;
4386 4417
4710 Set_Flag261 (Id, V); 4741 Set_Flag261 (Id, V);
4711 end Set_Has_Delayed_Rep_Aspects; 4742 end Set_Has_Delayed_Rep_Aspects;
4712 4743
4713 procedure Set_Has_Discriminants (Id : E; V : B := True) is 4744 procedure Set_Has_Discriminants (Id : E; V : B := True) is
4714 begin 4745 begin
4715 pragma Assert (Nkind (Id) in N_Entity); 4746 pragma Assert (Is_Type (Id));
4716 Set_Flag5 (Id, V); 4747 Set_Flag5 (Id, V);
4717 end Set_Has_Discriminants; 4748 end Set_Has_Discriminants;
4718 4749
4719 procedure Set_Has_Dispatch_Table (Id : E; V : B := True) is 4750 procedure Set_Has_Dispatch_Table (Id : E; V : B := True) is
4720 begin 4751 begin
5147 begin 5178 begin
5148 pragma Assert (Ekind (Id) = E_Variable); 5179 pragma Assert (Ekind (Id) = E_Variable);
5149 Set_Node8 (Id, V); 5180 Set_Node8 (Id, V);
5150 end Set_Hiding_Loop_Variable; 5181 end Set_Hiding_Loop_Variable;
5151 5182
5183 procedure Set_Hidden_In_Formal_Instance (Id : E; V : L) is
5184 begin
5185 pragma Assert (Ekind (Id) = E_Package);
5186 Set_Elist30 (Id, V);
5187 end Set_Hidden_In_Formal_Instance;
5188
5152 procedure Set_Homonym (Id : E; V : E) is 5189 procedure Set_Homonym (Id : E; V : E) is
5153 begin 5190 begin
5154 pragma Assert (Id /= V); 5191 pragma Assert (Id /= V);
5155 Set_Node4 (Id, V); 5192 Set_Node4 (Id, V);
5156 end Set_Homonym; 5193 end Set_Homonym;
5162 end Set_Incomplete_Actuals; 5199 end Set_Incomplete_Actuals;
5163 5200
5164 procedure Set_Ignore_SPARK_Mode_Pragmas (Id : E; V : B := True) is 5201 procedure Set_Ignore_SPARK_Mode_Pragmas (Id : E; V : B := True) is
5165 begin 5202 begin
5166 pragma Assert 5203 pragma Assert
5167 (Ekind_In (Id, E_Protected_Body, -- concurrent variants 5204 (Ekind_In (Id, E_Protected_Body, -- concurrent types
5168 E_Protected_Type, 5205 E_Protected_Type,
5169 E_Task_Body, 5206 E_Task_Body,
5170 E_Task_Type) 5207 E_Task_Type)
5171 or else 5208 or else
5172 Ekind_In (Id, E_Entry, -- overloadable variants 5209 Ekind_In (Id, E_Entry, -- overloadable
5173 E_Entry_Family, 5210 E_Entry_Family,
5174 E_Function, 5211 E_Function,
5175 E_Generic_Function, 5212 E_Generic_Function,
5176 E_Generic_Procedure, 5213 E_Generic_Procedure,
5177 E_Operator, 5214 E_Operator,
5178 E_Procedure, 5215 E_Procedure,
5179 E_Subprogram_Body) 5216 E_Subprogram_Body)
5180 or else 5217 or else
5181 Ekind_In (Id, E_Generic_Package, -- package variants 5218 Ekind_In (Id, E_Generic_Package, -- packages
5182 E_Package, 5219 E_Package,
5183 E_Package_Body)); 5220 E_Package_Body));
5184 Set_Flag301 (Id, V); 5221 Set_Flag301 (Id, V);
5185 end Set_Ignore_SPARK_Mode_Pragmas; 5222 end Set_Ignore_SPARK_Mode_Pragmas;
5186 5223
5263 begin 5300 begin
5264 pragma Assert (Is_Access_Type (Id)); 5301 pragma Assert (Is_Access_Type (Id));
5265 Set_Flag69 (Id, V); 5302 Set_Flag69 (Id, V);
5266 end Set_Is_Access_Constant; 5303 end Set_Is_Access_Constant;
5267 5304
5305 procedure Set_Is_Activation_Record (Id : E; V : B := True) is
5306 begin
5307 pragma Assert (Ekind (Id) = E_In_Parameter);
5308 Set_Flag305 (Id, V);
5309 end Set_Is_Activation_Record;
5310
5268 procedure Set_Is_Actual_Subtype (Id : E; V : B := True) is 5311 procedure Set_Is_Actual_Subtype (Id : E; V : B := True) is
5269 begin 5312 begin
5270 pragma Assert (Is_Type (Id)); 5313 pragma Assert (Is_Type (Id));
5271 Set_Flag293 (Id, V); 5314 Set_Flag293 (Id, V);
5272 end Set_Is_Actual_Subtype; 5315 end Set_Is_Actual_Subtype;
5434 Set_Flag6 (Id, V); 5477 Set_Flag6 (Id, V);
5435 end Set_Is_Dispatching_Operation; 5478 end Set_Is_Dispatching_Operation;
5436 5479
5437 procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True) is 5480 procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True) is
5438 begin 5481 begin
5439 pragma Assert 5482 pragma Assert (Is_Elaboration_Target (Id));
5440 (Ekind_In (Id, E_Constant, E_Variable)
5441 or else Is_Entry (Id)
5442 or else Is_Generic_Unit (Id)
5443 or else Is_Subprogram (Id)
5444 or else Is_Task_Type (Id));
5445 Set_Flag148 (Id, V); 5483 Set_Flag148 (Id, V);
5446 end Set_Is_Elaboration_Checks_OK_Id; 5484 end Set_Is_Elaboration_Checks_OK_Id;
5485
5486 procedure Set_Is_Elaboration_Warnings_OK_Id (Id : E; V : B := True) is
5487 begin
5488 pragma Assert (Is_Elaboration_Target (Id));
5489 Set_Flag304 (Id, V);
5490 end Set_Is_Elaboration_Warnings_OK_Id;
5447 5491
5448 procedure Set_Is_Eliminated (Id : E; V : B := True) is 5492 procedure Set_Is_Eliminated (Id : E; V : B := True) is
5449 begin 5493 begin
5450 Set_Flag124 (Id, V); 5494 Set_Flag124 (Id, V);
5451 end Set_Is_Eliminated; 5495 end Set_Is_Eliminated;
5659 5703
5660 procedure Set_Is_Limited_Record (Id : E; V : B := True) is 5704 procedure Set_Is_Limited_Record (Id : E; V : B := True) is
5661 begin 5705 begin
5662 Set_Flag25 (Id, V); 5706 Set_Flag25 (Id, V);
5663 end Set_Is_Limited_Record; 5707 end Set_Is_Limited_Record;
5708
5709 procedure Set_Is_Loop_Parameter (Id : E; V : B := True) is
5710 begin
5711 Set_Flag307 (Id, V);
5712 end Set_Is_Loop_Parameter;
5664 5713
5665 procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is 5714 procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is
5666 begin 5715 begin
5667 pragma Assert (Is_Subprogram (Id)); 5716 pragma Assert (Is_Subprogram (Id));
5668 Set_Flag137 (Id, V); 5717 Set_Flag137 (Id, V);
5907 end Set_Is_Unsigned_Type; 5956 end Set_Is_Unsigned_Type;
5908 5957
5909 procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is 5958 procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is
5910 begin 5959 begin
5911 pragma Assert 5960 pragma Assert
5912 (Ekind_In (Id, E_Constant, E_Variable) 5961 (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable)
5913 or else Is_Formal (Id) 5962 or else Is_Formal (Id)
5914 or else Is_Type (Id)); 5963 or else Is_Type (Id));
5915 Set_Flag283 (Id, V); 5964 Set_Flag283 (Id, V);
5916 end Set_Is_Uplevel_Referenced_Entity; 5965 end Set_Is_Uplevel_Referenced_Entity;
5917 5966
6055 procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True) is 6104 procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True) is
6056 begin 6105 begin
6057 pragma Assert (Is_Type (Id)); 6106 pragma Assert (Is_Type (Id));
6058 Set_Flag208 (Id, V); 6107 Set_Flag208 (Id, V);
6059 end Set_Must_Have_Preelab_Init; 6108 end Set_Must_Have_Preelab_Init;
6109
6110 procedure Set_Needs_Activation_Record (Id : E; V : B := True) is
6111 begin
6112 Set_Flag306 (Id, V);
6113 end Set_Needs_Activation_Record;
6060 6114
6061 procedure Set_Needs_Debug_Info (Id : E; V : B := True) is 6115 procedure Set_Needs_Debug_Info (Id : E; V : B := True) is
6062 begin 6116 begin
6063 Set_Flag147 (Id, V); 6117 Set_Flag147 (Id, V);
6064 end Set_Needs_Debug_Info; 6118 end Set_Needs_Debug_Info;
6268 E_Function, 6322 E_Function,
6269 E_Procedure)); 6323 E_Procedure));
6270 Set_Node14 (Id, V); 6324 Set_Node14 (Id, V);
6271 end Set_Postconditions_Proc; 6325 end Set_Postconditions_Proc;
6272 6326
6327 procedure Set_Predicated_Parent (Id : E; V : E) is
6328 begin
6329 pragma Assert (Ekind_In (Id, E_Array_Subtype,
6330 E_Record_Subtype,
6331 E_Record_Subtype_With_Private));
6332 Set_Node38 (Id, V);
6333 end Set_Predicated_Parent;
6334
6273 procedure Set_Predicates_Ignored (Id : E; V : B) is 6335 procedure Set_Predicates_Ignored (Id : E; V : B) is
6274 begin 6336 begin
6275 pragma Assert (Is_Type (Id)); 6337 pragma Assert (Is_Type (Id));
6276 Set_Flag288 (Id, V); 6338 Set_Flag288 (Id, V);
6277 end Set_Predicates_Ignored; 6339 end Set_Predicates_Ignored;
6298 begin 6360 begin
6299 pragma Assert (Is_Incomplete_Or_Private_Type (Id)); 6361 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
6300 Set_Elist18 (Id, V); 6362 Set_Elist18 (Id, V);
6301 end Set_Private_Dependents; 6363 end Set_Private_Dependents;
6302 6364
6303 procedure Set_Private_View (Id : E; V : N) is 6365 procedure Set_Prev_Entity (Id : E; V : E) is
6304 begin 6366 begin
6305 pragma Assert (Is_Private_Type (Id)); 6367 Set_Node36 (Id, V);
6306 Set_Node22 (Id, V); 6368 end Set_Prev_Entity;
6307 end Set_Private_View;
6308 6369
6309 procedure Set_Protected_Body_Subprogram (Id : E; V : E) is 6370 procedure Set_Protected_Body_Subprogram (Id : E; V : E) is
6310 begin 6371 begin
6311 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id)); 6372 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
6312 Set_Node11 (Id, V); 6373 Set_Node11 (Id, V);
6490 procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True) is 6551 procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True) is
6491 begin 6552 begin
6492 Set_Flag167 (Id, V); 6553 Set_Flag167 (Id, V);
6493 end Set_Sec_Stack_Needed_For_Return; 6554 end Set_Sec_Stack_Needed_For_Return;
6494 6555
6495 procedure Set_Shadow_Entities (Id : E; V : S) is
6496 begin
6497 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
6498 Set_List14 (Id, V);
6499 end Set_Shadow_Entities;
6500
6501 procedure Set_Shared_Var_Procs_Instance (Id : E; V : E) is 6556 procedure Set_Shared_Var_Procs_Instance (Id : E; V : E) is
6502 begin 6557 begin
6503 pragma Assert (Ekind (Id) = E_Variable); 6558 pragma Assert (Ekind (Id) = E_Variable);
6504 Set_Node22 (Id, V); 6559 Set_Node22 (Id, V);
6505 end Set_Shared_Var_Procs_Instance; 6560 end Set_Shared_Var_Procs_Instance;
6527 end Set_Small_Value; 6582 end Set_Small_Value;
6528 6583
6529 procedure Set_SPARK_Aux_Pragma (Id : E; V : N) is 6584 procedure Set_SPARK_Aux_Pragma (Id : E; V : N) is
6530 begin 6585 begin
6531 pragma Assert 6586 pragma Assert
6532 (Ekind_In (Id, E_Protected_Type, -- concurrent variants 6587 (Ekind_In (Id, E_Protected_Type, -- concurrent types
6533 E_Task_Type) 6588 E_Task_Type)
6534 or else 6589 or else
6535 Ekind_In (Id, E_Generic_Package, -- package variants 6590 Ekind_In (Id, E_Generic_Package, -- packages
6536 E_Package, 6591 E_Package,
6537 E_Package_Body)); 6592 E_Package_Body));
6538 Set_Node41 (Id, V); 6593 Set_Node41 (Id, V);
6539 end Set_SPARK_Aux_Pragma; 6594 end Set_SPARK_Aux_Pragma;
6540 6595
6541 procedure Set_SPARK_Aux_Pragma_Inherited (Id : E; V : B := True) is 6596 procedure Set_SPARK_Aux_Pragma_Inherited (Id : E; V : B := True) is
6542 begin 6597 begin
6543 pragma Assert 6598 pragma Assert
6544 (Ekind_In (Id, E_Protected_Type, -- concurrent variants 6599 (Ekind_In (Id, E_Protected_Type, -- concurrent types
6545 E_Task_Type) 6600 E_Task_Type)
6546 or else 6601 or else
6547 Ekind_In (Id, E_Generic_Package, -- package variants 6602 Ekind_In (Id, E_Generic_Package, -- packages
6548 E_Package, 6603 E_Package,
6549 E_Package_Body)); 6604 E_Package_Body));
6550 Set_Flag266 (Id, V); 6605 Set_Flag266 (Id, V);
6551 end Set_SPARK_Aux_Pragma_Inherited; 6606 end Set_SPARK_Aux_Pragma_Inherited;
6552 6607
6553 procedure Set_SPARK_Pragma (Id : E; V : N) is 6608 procedure Set_SPARK_Pragma (Id : E; V : N) is
6554 begin 6609 begin
6555 pragma Assert 6610 pragma Assert
6556 (Ekind_In (Id, E_Protected_Body, -- concurrent variants 6611 (Ekind_In (Id, E_Constant, -- objects
6557 E_Protected_Type,
6558 E_Task_Body,
6559 E_Task_Type)
6560 or else
6561 Ekind_In (Id, E_Constant, -- object variants
6562 E_Variable) 6612 E_Variable)
6563 or else 6613 or else
6564 Ekind_In (Id, E_Entry, -- overloadable variants 6614 Ekind_In (Id, E_Abstract_State, -- overloadable
6615 E_Entry,
6565 E_Entry_Family, 6616 E_Entry_Family,
6566 E_Function, 6617 E_Function,
6567 E_Generic_Function, 6618 E_Generic_Function,
6568 E_Generic_Procedure, 6619 E_Generic_Procedure,
6569 E_Operator, 6620 E_Operator,
6570 E_Procedure, 6621 E_Procedure,
6571 E_Subprogram_Body) 6622 E_Subprogram_Body)
6572 or else 6623 or else
6573 Ekind_In (Id, E_Generic_Package, -- package variants 6624 Ekind_In (Id, E_Generic_Package, -- packages
6574 E_Package, 6625 E_Package,
6575 E_Package_Body) 6626 E_Package_Body)
6576 or else 6627 or else
6577 Ekind (Id) = E_Void); -- special purpose 6628 Ekind (Id) = E_Void -- special purpose
6629 or else
6630 Ekind_In (Id, E_Protected_Body, -- types
6631 E_Task_Body)
6632 or else
6633 Is_Type (Id));
6578 Set_Node40 (Id, V); 6634 Set_Node40 (Id, V);
6579 end Set_SPARK_Pragma; 6635 end Set_SPARK_Pragma;
6580 6636
6581 procedure Set_SPARK_Pragma_Inherited (Id : E; V : B := True) is 6637 procedure Set_SPARK_Pragma_Inherited (Id : E; V : B := True) is
6582 begin 6638 begin
6583 pragma Assert 6639 pragma Assert
6584 (Ekind_In (Id, E_Protected_Body, -- concurrent variants 6640 (Ekind_In (Id, E_Constant, -- objects
6585 E_Protected_Type,
6586 E_Task_Body,
6587 E_Task_Type)
6588 or else
6589 Ekind_In (Id, E_Constant, -- object variants
6590 E_Variable) 6641 E_Variable)
6591 or else 6642 or else
6592 Ekind_In (Id, E_Entry, -- overloadable variants 6643 Ekind_In (Id, E_Abstract_State, -- overloadable
6644 E_Entry,
6593 E_Entry_Family, 6645 E_Entry_Family,
6594 E_Function, 6646 E_Function,
6595 E_Generic_Function, 6647 E_Generic_Function,
6596 E_Generic_Procedure, 6648 E_Generic_Procedure,
6597 E_Operator, 6649 E_Operator,
6598 E_Procedure, 6650 E_Procedure,
6599 E_Subprogram_Body) 6651 E_Subprogram_Body)
6600 or else 6652 or else
6601 Ekind_In (Id, E_Generic_Package, -- package variants 6653 Ekind_In (Id, E_Generic_Package, -- packages
6602 E_Package, 6654 E_Package,
6603 E_Package_Body) 6655 E_Package_Body)
6604 or else 6656 or else
6605 Ekind (Id) = E_Void); -- special purpose 6657 Ekind (Id) = E_Void -- special purpose
6658 or else
6659 Ekind_In (Id, E_Protected_Body, -- types
6660 E_Task_Body)
6661 or else
6662 Is_Type (Id));
6606 Set_Flag265 (Id, V); 6663 Set_Flag265 (Id, V);
6607 end Set_SPARK_Pragma_Inherited; 6664 end Set_SPARK_Pragma_Inherited;
6608 6665
6609 procedure Set_Spec_Entity (Id : E; V : E) is 6666 procedure Set_Spec_Entity (Id : E; V : E) is
6610 begin 6667 begin
6709 begin 6766 begin
6710 pragma Assert (Is_Subprogram (Id)); 6767 pragma Assert (Is_Subprogram (Id));
6711 Set_Uint24 (Id, V); 6768 Set_Uint24 (Id, V);
6712 end Set_Subps_Index; 6769 end Set_Subps_Index;
6713 6770
6771 procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is
6772 begin
6773 Set_Flag303 (Id, V);
6774 end Set_Suppress_Elaboration_Warnings;
6775
6714 procedure Set_Suppress_Initialization (Id : E; V : B := True) is 6776 procedure Set_Suppress_Initialization (Id : E; V : B := True) is
6715 begin 6777 begin
6716 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable); 6778 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
6717 Set_Flag105 (Id, V); 6779 Set_Flag105 (Id, V);
6718 end Set_Suppress_Initialization; 6780 end Set_Suppress_Initialization;
6785 end Set_Uses_Sec_Stack; 6847 end Set_Uses_Sec_Stack;
6786 6848
6787 procedure Set_Validated_Object (Id : E; V : N) is 6849 procedure Set_Validated_Object (Id : E; V : N) is
6788 begin 6850 begin
6789 pragma Assert (Ekind (Id) = E_Variable); 6851 pragma Assert (Ekind (Id) = E_Variable);
6790 Set_Node36 (Id, V); 6852 Set_Node38 (Id, V);
6791 end Set_Validated_Object; 6853 end Set_Validated_Object;
6792 6854
6793 procedure Set_Warnings_Off (Id : E; V : B := True) is 6855 procedure Set_Warnings_Off (Id : E; V : B := True) is
6794 begin 6856 begin
6795 Set_Flag96 (Id, V); 6857 Set_Flag96 (Id, V);
7139 7201
7140 ------------------- 7202 -------------------
7141 -- Append_Entity -- 7203 -- Append_Entity --
7142 ------------------- 7204 -------------------
7143 7205
7144 procedure Append_Entity (Id : Entity_Id; V : Entity_Id) is 7206 procedure Append_Entity (Id : Entity_Id; Scop : Entity_Id) is
7145 begin 7207 Last : constant Entity_Id := Last_Entity (Scop);
7146 if Last_Entity (V) = Empty then 7208
7147 Set_First_Entity (Id => V, V => Id); 7209 begin
7210 Set_Scope (Id, Scop);
7211 Set_Prev_Entity (Id, Empty); -- Empty <-- Id
7212
7213 -- The entity chain is empty
7214
7215 if No (Last) then
7216 Set_First_Entity (Scop, Id);
7217
7218 -- Otherwise the entity chain has at least one element
7219
7148 else 7220 else
7149 Set_Next_Entity (Last_Entity (V), Id); 7221 Link_Entities (Last, Id); -- Last <-- Id, Last --> Id
7150 end if; 7222 end if;
7151 7223
7152 Set_Next_Entity (Id, Empty); 7224 -- NOTE: The setting of the Next_Entity attribute of Id must happen
7153 Set_Scope (Id, V); 7225 -- here as opposed to at the beginning of the routine because doing
7154 Set_Last_Entity (Id => V, V => Id); 7226 -- so causes the binder to hang. It is not clear why ???
7227
7228 Set_Next_Entity (Id, Empty); -- Id --> Empty
7229
7230 Set_Last_Entity (Scop, Id);
7155 end Append_Entity; 7231 end Append_Entity;
7156 7232
7157 --------------- 7233 ---------------
7158 -- Base_Type -- 7234 -- Base_Type --
7159 --------------- 7235 ---------------
8042 8118
8043 or else (Kind = N_Attribute_Reference 8119 or else (Kind = N_Attribute_Reference
8044 and then Is_Entity_Attribute_Name (Attribute_Name (N))); 8120 and then Is_Entity_Attribute_Name (Attribute_Name (N)));
8045 end Is_Entity_Name; 8121 end Is_Entity_Name;
8046 8122
8123 ---------------------------
8124 -- Is_Elaboration_Target --
8125 ---------------------------
8126
8127 function Is_Elaboration_Target (Id : Entity_Id) return Boolean is
8128 begin
8129 return
8130 Ekind_In (Id, E_Constant, E_Variable)
8131 or else Is_Entry (Id)
8132 or else Is_Generic_Unit (Id)
8133 or else Is_Subprogram (Id)
8134 or else Is_Task_Type (Id);
8135 end Is_Elaboration_Target;
8136
8047 ----------------------- 8137 -----------------------
8048 -- Is_External_State -- 8138 -- Is_External_State --
8049 ----------------------- 8139 -----------------------
8050 8140
8051 function Is_External_State (Id : E) return B is 8141 function Is_External_State (Id : E) return B is
8052 begin 8142 begin
8143 -- To qualify, the abstract state must appear with option "external" or
8144 -- "synchronous" (SPARK RM 7.1.4(8) and (10)).
8145
8053 return 8146 return
8054 Ekind (Id) = E_Abstract_State and then Has_Option (Id, Name_External); 8147 Ekind (Id) = E_Abstract_State
8148 and then (Has_Option (Id, Name_External)
8149 or else
8150 Has_Option (Id, Name_Synchronous));
8055 end Is_External_State; 8151 end Is_External_State;
8056 8152
8057 ------------------ 8153 ------------------
8058 -- Is_Finalizer -- 8154 -- Is_Finalizer --
8059 ------------------ 8155 ------------------
8220 -- Is_Synchronized_State -- 8316 -- Is_Synchronized_State --
8221 --------------------------- 8317 ---------------------------
8222 8318
8223 function Is_Synchronized_State (Id : E) return B is 8319 function Is_Synchronized_State (Id : E) return B is
8224 begin 8320 begin
8321 -- To qualify, the abstract state must appear with simple option
8322 -- "synchronous" (SPARK RM 7.1.4(10)).
8323
8225 return 8324 return
8226 Ekind (Id) = E_Abstract_State 8325 Ekind (Id) = E_Abstract_State
8227 and then Has_Option (Id, Name_Synchronous); 8326 and then Has_Option (Id, Name_Synchronous);
8228 end Is_Synchronized_State; 8327 end Is_Synchronized_State;
8229 8328
8258 -- Is_Wrapper_Package -- 8357 -- Is_Wrapper_Package --
8259 ------------------------ 8358 ------------------------
8260 8359
8261 function Is_Wrapper_Package (Id : E) return B is 8360 function Is_Wrapper_Package (Id : E) return B is
8262 begin 8361 begin
8263 return (Ekind (Id) = E_Package and then Present (Related_Instance (Id))); 8362 return Ekind (Id) = E_Package and then Present (Related_Instance (Id));
8264 end Is_Wrapper_Package; 8363 end Is_Wrapper_Package;
8265 8364
8266 ----------------- 8365 -----------------
8267 -- Last_Formal -- 8366 -- Last_Formal --
8268 ----------------- 8367 -----------------
8290 end if; 8389 end if;
8291 8390
8292 return Formal; 8391 return Formal;
8293 end if; 8392 end if;
8294 end Last_Formal; 8393 end Last_Formal;
8394
8395 -------------------
8396 -- Link_Entities --
8397 -------------------
8398
8399 procedure Link_Entities (First : Entity_Id; Second : Node_Id) is
8400 begin
8401 if Present (Second) then
8402 Set_Prev_Entity (Second, First); -- First <-- Second
8403 end if;
8404
8405 Set_Next_Entity (First, Second); -- First --> Second
8406 end Link_Entities;
8407
8408 ----------------------
8409 -- Model_Emin_Value --
8410 ----------------------
8295 8411
8296 function Model_Emin_Value (Id : E) return Uint is 8412 function Model_Emin_Value (Id : E) return Uint is
8297 begin 8413 begin
8298 return Machine_Emin_Value (Id); 8414 return Machine_Emin_Value (Id);
8299 end Model_Emin_Value; 8415 end Model_Emin_Value;
8610 Formal := Next_Formal (Formal); 8726 Formal := Next_Formal (Formal);
8611 end loop; 8727 end loop;
8612 8728
8613 return N; 8729 return N;
8614 end Number_Formals; 8730 end Number_Formals;
8731
8732 ------------------------
8733 -- Object_Size_Clause --
8734 ------------------------
8735
8736 function Object_Size_Clause (Id : E) return N is
8737 begin
8738 return Get_Attribute_Definition_Clause (Id, Attribute_Object_Size);
8739 end Object_Size_Clause;
8615 8740
8616 -------------------- 8741 --------------------
8617 -- Parameter_Mode -- 8742 -- Parameter_Mode --
8618 -------------------- 8743 --------------------
8619 8744
8756 (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id))) 8881 (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id)))
8757 and then Present (Full_View (Id)) 8882 and then Present (Full_View (Id))
8758 then 8883 then
8759 Typ := Full_View (Id); 8884 Typ := Full_View (Id);
8760 8885
8886 elsif Ekind_In (Id, E_Array_Subtype,
8887 E_Record_Subtype,
8888 E_Record_Subtype_With_Private)
8889 and then Present (Predicated_Parent (Id))
8890 then
8891 Typ := Predicated_Parent (Id);
8892
8761 else 8893 else
8762 Typ := Id; 8894 Typ := Id;
8763 end if; 8895 end if;
8764 8896
8765 Subps := Subprograms_For_Type (Typ); 8897 Subps := Subprograms_For_Type (Typ);
8882 procedure Record_Rep_Item (E : Entity_Id; N : Node_Id) is 9014 procedure Record_Rep_Item (E : Entity_Id; N : Node_Id) is
8883 begin 9015 begin
8884 Set_Next_Rep_Item (N, First_Rep_Item (E)); 9016 Set_Next_Rep_Item (N, First_Rep_Item (E));
8885 Set_First_Rep_Item (E, N); 9017 Set_First_Rep_Item (E, N);
8886 end Record_Rep_Item; 9018 end Record_Rep_Item;
9019
9020 -------------------
9021 -- Remove_Entity --
9022 -------------------
9023
9024 procedure Remove_Entity (Id : Entity_Id) is
9025 Next : constant Entity_Id := Next_Entity (Id);
9026 Prev : constant Entity_Id := Prev_Entity (Id);
9027 Scop : constant Entity_Id := Scope (Id);
9028 First : constant Entity_Id := First_Entity (Scop);
9029 Last : constant Entity_Id := Last_Entity (Scop);
9030
9031 begin
9032 -- Eliminate any existing linkages from the entity
9033
9034 Set_Prev_Entity (Id, Empty); -- Empty <-- Id
9035 Set_Next_Entity (Id, Empty); -- Id --> Empty
9036
9037 -- The eliminated entity was the only element in the entity chain
9038
9039 if Id = First and then Id = Last then
9040 Set_First_Entity (Scop, Empty);
9041 Set_Last_Entity (Scop, Empty);
9042
9043 -- The eliminated entity was the head of the entity chain
9044
9045 elsif Id = First then
9046 Set_First_Entity (Scop, Next);
9047
9048 -- The eliminated entity was the tail of the entity chain
9049
9050 elsif Id = Last then
9051 Set_Last_Entity (Scop, Prev);
9052
9053 -- Otherwise the eliminated entity comes from the middle of the entity
9054 -- chain.
9055
9056 else
9057 Link_Entities (Prev, Next); -- Prev <-- Next, Prev --> Next
9058 end if;
9059 end Remove_Entity;
8887 9060
8888 --------------- 9061 ---------------
8889 -- Root_Type -- 9062 -- Root_Type --
8890 --------------- 9063 ---------------
8891 9064
9432 9605
9433 else 9606 else
9434 return Id; 9607 return Id;
9435 end if; 9608 end if;
9436 end Underlying_Type; 9609 end Underlying_Type;
9610
9611 ------------------------
9612 -- Unlink_Next_Entity --
9613 ------------------------
9614
9615 procedure Unlink_Next_Entity (Id : Entity_Id) is
9616 Next : constant Entity_Id := Next_Entity (Id);
9617
9618 begin
9619 if Present (Next) then
9620 Set_Prev_Entity (Next, Empty); -- Empty <-- Next
9621 end if;
9622
9623 Set_Next_Entity (Id, Empty); -- Id --> Empty
9624 end Unlink_Next_Entity;
9437 9625
9438 ------------------------ 9626 ------------------------
9439 -- Write_Entity_Flags -- 9627 -- Write_Entity_Flags --
9440 ------------------------ 9628 ------------------------
9441 9629
9599 W ("In_Private_Part", Flag45 (Id)); 9787 W ("In_Private_Part", Flag45 (Id));
9600 W ("In_Use", Flag8 (Id)); 9788 W ("In_Use", Flag8 (Id));
9601 W ("Is_Abstract_Subprogram", Flag19 (Id)); 9789 W ("Is_Abstract_Subprogram", Flag19 (Id));
9602 W ("Is_Abstract_Type", Flag146 (Id)); 9790 W ("Is_Abstract_Type", Flag146 (Id));
9603 W ("Is_Access_Constant", Flag69 (Id)); 9791 W ("Is_Access_Constant", Flag69 (Id));
9792 W ("Is_Activation_Record", Flag305 (Id));
9604 W ("Is_Actual_Subtype", Flag293 (Id)); 9793 W ("Is_Actual_Subtype", Flag293 (Id));
9605 W ("Is_Ada_2005_Only", Flag185 (Id)); 9794 W ("Is_Ada_2005_Only", Flag185 (Id));
9606 W ("Is_Ada_2012_Only", Flag199 (Id)); 9795 W ("Is_Ada_2012_Only", Flag199 (Id));
9607 W ("Is_Aliased", Flag15 (Id)); 9796 W ("Is_Aliased", Flag15 (Id));
9608 W ("Is_Asynchronous", Flag81 (Id)); 9797 W ("Is_Asynchronous", Flag81 (Id));
9628 W ("Is_Discrim_SO_Function", Flag176 (Id)); 9817 W ("Is_Discrim_SO_Function", Flag176 (Id));
9629 W ("Is_Discriminant_Check_Function", Flag264 (Id)); 9818 W ("Is_Discriminant_Check_Function", Flag264 (Id));
9630 W ("Is_Dispatch_Table_Entity", Flag234 (Id)); 9819 W ("Is_Dispatch_Table_Entity", Flag234 (Id));
9631 W ("Is_Dispatching_Operation", Flag6 (Id)); 9820 W ("Is_Dispatching_Operation", Flag6 (Id));
9632 W ("Is_Elaboration_Checks_OK_Id", Flag148 (Id)); 9821 W ("Is_Elaboration_Checks_OK_Id", Flag148 (Id));
9822 W ("Is_Elaboration_Warnings_OK_Id", Flag304 (Id));
9633 W ("Is_Eliminated", Flag124 (Id)); 9823 W ("Is_Eliminated", Flag124 (Id));
9634 W ("Is_Entry_Formal", Flag52 (Id)); 9824 W ("Is_Entry_Formal", Flag52 (Id));
9635 W ("Is_Exception_Handler", Flag286 (Id)); 9825 W ("Is_Exception_Handler", Flag286 (Id));
9636 W ("Is_Exported", Flag99 (Id)); 9826 W ("Is_Exported", Flag99 (Id));
9637 W ("Is_Finalized_Transient", Flag252 (Id)); 9827 W ("Is_Finalized_Transient", Flag252 (Id));
9667 W ("Is_Known_Valid", Flag170 (Id)); 9857 W ("Is_Known_Valid", Flag170 (Id));
9668 W ("Is_Limited_Composite", Flag106 (Id)); 9858 W ("Is_Limited_Composite", Flag106 (Id));
9669 W ("Is_Limited_Interface", Flag197 (Id)); 9859 W ("Is_Limited_Interface", Flag197 (Id));
9670 W ("Is_Limited_Record", Flag25 (Id)); 9860 W ("Is_Limited_Record", Flag25 (Id));
9671 W ("Is_Local_Anonymous_Access", Flag194 (Id)); 9861 W ("Is_Local_Anonymous_Access", Flag194 (Id));
9862 W ("Is_Loop_Parameter", Flag307 (Id));
9672 W ("Is_Machine_Code_Subprogram", Flag137 (Id)); 9863 W ("Is_Machine_Code_Subprogram", Flag137 (Id));
9673 W ("Is_Non_Static_Subtype", Flag109 (Id)); 9864 W ("Is_Non_Static_Subtype", Flag109 (Id));
9674 W ("Is_Null_Init_Proc", Flag178 (Id)); 9865 W ("Is_Null_Init_Proc", Flag178 (Id));
9675 W ("Is_Obsolescent", Flag153 (Id)); 9866 W ("Is_Obsolescent", Flag153 (Id));
9676 W ("Is_Only_Out_Parameter", Flag226 (Id)); 9867 W ("Is_Only_Out_Parameter", Flag226 (Id));
9725 W ("Machine_Radix_10", Flag84 (Id)); 9916 W ("Machine_Radix_10", Flag84 (Id));
9726 W ("Materialize_Entity", Flag168 (Id)); 9917 W ("Materialize_Entity", Flag168 (Id));
9727 W ("May_Inherit_Delayed_Rep_Aspects", Flag262 (Id)); 9918 W ("May_Inherit_Delayed_Rep_Aspects", Flag262 (Id));
9728 W ("Must_Be_On_Byte_Boundary", Flag183 (Id)); 9919 W ("Must_Be_On_Byte_Boundary", Flag183 (Id));
9729 W ("Must_Have_Preelab_Init", Flag208 (Id)); 9920 W ("Must_Have_Preelab_Init", Flag208 (Id));
9921 W ("Needs_Activation_Record", Flag306 (Id));
9730 W ("Needs_Debug_Info", Flag147 (Id)); 9922 W ("Needs_Debug_Info", Flag147 (Id));
9731 W ("Needs_No_Actuals", Flag22 (Id)); 9923 W ("Needs_No_Actuals", Flag22 (Id));
9732 W ("Never_Set_In_Source", Flag115 (Id)); 9924 W ("Never_Set_In_Source", Flag115 (Id));
9733 W ("No_Dynamic_Predicate_On_actual", Flag276 (Id)); 9925 W ("No_Dynamic_Predicate_On_actual", Flag276 (Id));
9734 W ("No_Pool_Assigned", Flag131 (Id)); 9926 W ("No_Pool_Assigned", Flag131 (Id));
9763 W ("SSO_Set_High_By_Default", Flag273 (Id)); 9955 W ("SSO_Set_High_By_Default", Flag273 (Id));
9764 W ("SSO_Set_Low_By_Default", Flag272 (Id)); 9956 W ("SSO_Set_Low_By_Default", Flag272 (Id));
9765 W ("Static_Elaboration_Desired", Flag77 (Id)); 9957 W ("Static_Elaboration_Desired", Flag77 (Id));
9766 W ("Stores_Attribute_Old_Prefix", Flag270 (Id)); 9958 W ("Stores_Attribute_Old_Prefix", Flag270 (Id));
9767 W ("Strict_Alignment", Flag145 (Id)); 9959 W ("Strict_Alignment", Flag145 (Id));
9960 W ("Suppress_Elaboration_Warnings", Flag303 (Id));
9768 W ("Suppress_Initialization", Flag105 (Id)); 9961 W ("Suppress_Initialization", Flag105 (Id));
9769 W ("Suppress_Style_Checks", Flag165 (Id)); 9962 W ("Suppress_Style_Checks", Flag165 (Id));
9770 W ("Suppress_Value_Tracking_On_Call", Flag217 (Id)); 9963 W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
9771 W ("Treat_As_Volatile", Flag41 (Id)); 9964 W ("Treat_As_Volatile", Flag41 (Id));
9772 W ("Universal_Aliasing", Flag216 (Id)); 9965 W ("Universal_Aliasing", Flag216 (Id));
10134 when E_Component 10327 when E_Component
10135 | E_Discriminant 10328 | E_Discriminant
10136 => 10329 =>
10137 Write_Str ("Component_Clause"); 10330 Write_Str ("Component_Clause");
10138 10331
10139 when E_Function 10332 when E_Entry
10333 | E_Entry_Family
10334 | E_Function
10140 | E_Procedure 10335 | E_Procedure
10141 | E_Package 10336 | E_Package
10142 | Generic_Unit_Kind 10337 | Generic_Unit_Kind
10143 => 10338 =>
10144 Write_Str ("Elaboration_Entity"); 10339 Write_Str ("Elaboration_Entity");
10181 | E_Entry_Family 10376 | E_Entry_Family
10182 | E_Function 10377 | E_Function
10183 | E_Procedure 10378 | E_Procedure
10184 => 10379 =>
10185 Write_Str ("Postconditions_Proc"); 10380 Write_Str ("Postconditions_Proc");
10186
10187 when E_Generic_Package
10188 | E_Package
10189 =>
10190 Write_Str ("Shadow_Entities");
10191 10381
10192 when others => 10382 when others =>
10193 Write_Str ("Field14??"); 10383 Write_Str ("Field14??");
10194 end case; 10384 end case;
10195 end Write_Field14_Name; 10385 end Write_Field14_Name;
10622 Write_Str ("Original_Record_Component"); 10812 Write_Str ("Original_Record_Component");
10623 10813
10624 when E_Enumeration_Literal => 10814 when E_Enumeration_Literal =>
10625 Write_Str ("Enumeration_Rep_Expr"); 10815 Write_Str ("Enumeration_Rep_Expr");
10626 10816
10627 when E_Limited_Private_Subtype
10628 | E_Limited_Private_Type
10629 | E_Private_Subtype
10630 | E_Private_Type
10631 | E_Record_Subtype_With_Private
10632 | E_Record_Type_With_Private
10633 =>
10634 Write_Str ("Private_View");
10635
10636 when Formal_Kind => 10817 when Formal_Kind =>
10637 Write_Str ("Protected_Formal"); 10818 Write_Str ("Protected_Formal");
10638 10819
10639 when E_Block 10820 when E_Block
10640 | E_Entry 10821 | E_Entry
10734 ------------------------ 10915 ------------------------
10735 10916
10736 procedure Write_Field24_Name (Id : Entity_Id) is 10917 procedure Write_Field24_Name (Id : Entity_Id) is
10737 begin 10918 begin
10738 case Ekind (Id) is 10919 case Ekind (Id) is
10920 when E_Package =>
10921 Write_Str ("Incomplete_Actuals");
10922
10739 when Type_Kind 10923 when Type_Kind
10740 | E_Constant 10924 | E_Constant
10741 | E_Variable 10925 | E_Variable
10742 => 10926 =>
10743 Write_Str ("Related_Expression"); 10927 Write_Str ("Related_Expression");
10745 when E_Function 10929 when E_Function
10746 | E_Operator 10930 | E_Operator
10747 | E_Procedure 10931 | E_Procedure
10748 => 10932 =>
10749 Write_Str ("Subps_Index"); 10933 Write_Str ("Subps_Index");
10750
10751 when E_Package =>
10752 Write_Str ("Incomplete_Actuals");
10753 10934
10754 when others => 10935 when others =>
10755 Write_Str ("Field24???"); 10936 Write_Str ("Field24???");
10756 end case; 10937 end case;
10757 end Write_Field24_Name; 10938 end Write_Field24_Name;
11114 ------------------------ 11295 ------------------------
11115 -- Write_Field36_Name -- 11296 -- Write_Field36_Name --
11116 ------------------------ 11297 ------------------------
11117 11298
11118 procedure Write_Field36_Name (Id : Entity_Id) is 11299 procedure Write_Field36_Name (Id : Entity_Id) is
11119 begin 11300 pragma Unreferenced (Id);
11120 case Ekind (Id) is 11301 begin
11121 when E_Variable => 11302 Write_Str ("Prev_Entity");
11122 Write_Str ("Validated_Object");
11123
11124 when others =>
11125 Write_Str ("Field36??");
11126 end case;
11127 end Write_Field36_Name; 11303 end Write_Field36_Name;
11128 11304
11129 ------------------------ 11305 ------------------------
11130 -- Write_Field37_Name -- 11306 -- Write_Field37_Name --
11131 ------------------------ 11307 ------------------------
11144 begin 11320 begin
11145 case Ekind (Id) is 11321 case Ekind (Id) is
11146 when E_Function 11322 when E_Function
11147 | E_Procedure 11323 | E_Procedure
11148 => 11324 =>
11149 Write_Str ("class-wide clone"); 11325 Write_Str ("Class_Wide_Clone");
11326
11327 when E_Array_Subtype
11328 | E_Record_Subtype
11329 | E_Record_Subtype_With_Private
11330 =>
11331 Write_Str ("Predicated_Parent");
11332
11333 when E_Variable =>
11334 Write_Str ("Validated_Object");
11150 11335
11151 when others => 11336 when others =>
11152 Write_Str ("Field38??"); 11337 Write_Str ("Field38??");
11153 end case; 11338 end case;
11154 end Write_Field38_Name; 11339 end Write_Field38_Name;
11175 ------------------------ 11360 ------------------------
11176 11361
11177 procedure Write_Field40_Name (Id : Entity_Id) is 11362 procedure Write_Field40_Name (Id : Entity_Id) is
11178 begin 11363 begin
11179 case Ekind (Id) is 11364 case Ekind (Id) is
11180 when E_Constant 11365 when E_Abstract_State
11366 | E_Constant
11181 | E_Entry 11367 | E_Entry
11182 | E_Entry_Family 11368 | E_Entry_Family
11183 | E_Function 11369 | E_Function
11184 | E_Generic_Function 11370 | E_Generic_Function
11185 | E_Generic_Package 11371 | E_Generic_Package
11187 | E_Operator 11373 | E_Operator
11188 | E_Package 11374 | E_Package
11189 | E_Package_Body 11375 | E_Package_Body
11190 | E_Procedure 11376 | E_Procedure
11191 | E_Protected_Body 11377 | E_Protected_Body
11192 | E_Protected_Type
11193 | E_Subprogram_Body 11378 | E_Subprogram_Body
11194 | E_Task_Body 11379 | E_Task_Body
11195 | E_Task_Type
11196 | E_Variable 11380 | E_Variable
11197 | E_Void 11381 | E_Void
11382 | Type_Kind
11198 => 11383 =>
11199 Write_Str ("SPARK_Pragma"); 11384 Write_Str ("SPARK_Pragma");
11200 11385
11201 when others => 11386 when others =>
11202 Write_Str ("Field40??"); 11387 Write_Str ("Field40??");