1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- A T R E E -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 1992-2021, Free Software Foundation, Inc. -- 10-- -- 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- -- 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- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26-- This package defines the low-level representation of the tree used to 27-- represent the Ada program internally. Syntactic and semantic information 28-- is combined in this tree. There is no separate symbol table structure. 29 30-- WARNING: There is a C++ version of this package. Any changes to this source 31-- file must be properly reflected in the C++ header file atree.h. 32 33-- Package Atree defines the basic structure of the tree and its nodes and 34-- provides the basic abstract interface for manipulating the tree. Two other 35-- packages use this interface to define the representation of Ada programs 36-- using this tree format. The package Sinfo defines the basic representation 37-- of the syntactic structure of the program, as output by the parser. The 38-- package Einfo defines the semantic information that is added to the tree 39-- nodes that represent declared entities (i.e. the information that is 40-- described in a separate symbol table structure in some other compilers). 41 42-- The front end of the compiler first parses the program and generates a 43-- tree that is simply a syntactic representation of the program in abstract 44-- syntax tree format. Subsequent processing in the front end traverses the 45-- tree, transforming it in various ways and adding semantic information. 46 47with Alloc; 48with Sinfo.Nodes; use Sinfo.Nodes; 49with Einfo.Entities; use Einfo.Entities; 50with Einfo.Utils; use Einfo.Utils; 51with Types; use Types; 52with Seinfo; use Seinfo; 53with System; use System; 54with Table; 55with Unchecked_Conversion; 56 57package Atree is 58 59 -- Access to node fields is generally done through the getters and setters 60 -- in packages Sinfo.Nodes and Einfo.Entities, which are automatically 61 -- generated (see Gen_IL.Gen). However, in specialized circumstances 62 -- (examples are the circuit in generic instantiation to copy trees, and in 63 -- the tree dump routine), it is useful to be able to do untyped 64 -- traversals, and an internal package in Atree allows for direct untyped 65 -- accesses in such cases. 66 67 function Last_Node_Id return Node_Id; 68 -- Returns Id of last allocated node Id 69 70 function Node_Offsets_Address return System.Address; 71 function Slots_Address return System.Address; 72 -- Address of Node_Offsets.Table and Slots.Table. Used in Back_End for Gigi 73 -- call. 74 75 function Approx_Num_Nodes_And_Entities return Nat; 76 -- This is an approximation to the number of nodes and entities allocated, 77 -- used to determine sizes of hash tables. 78 79 ----------------------- 80 -- Use of Empty Node -- 81 ----------------------- 82 83 -- The special Node_Id Empty is used to mark missing fields, similar to 84 -- "null" in Ada. Whenever the syntax has an optional component, then the 85 -- corresponding field will be set to Empty if the component is missing. 86 87 -- Note: Empty is not used to describe an empty list. Instead in this 88 -- case the node field contains a list which is empty, and these cases 89 -- should be distinguished (essentially from a type point of view, Empty 90 -- is a Node, not a list). 91 92 -- Note: Empty does in fact correspond to an allocated node. The Nkind 93 -- field of this node may be referenced. It contains N_Empty, which 94 -- uniquely identifies the empty case. This allows the Nkind field to be 95 -- dereferenced before the check for Empty which is sometimes useful. We 96 -- also access certain other fields of Empty; see comments in 97 -- Gen_IL.Gen.Gen_Nodes. 98 99 ----------------------- 100 -- Use of Error Node -- 101 ----------------------- 102 103 -- The Error node is used during syntactic and semantic analysis to 104 -- indicate that the corresponding piece of syntactic structure or 105 -- semantic meaning cannot properly be represented in the tree because 106 -- of an illegality in the program. 107 108 -- If an Error node is encountered, then you know that a previous 109 -- illegality has been detected. The proper reaction should be to 110 -- avoid posting related cascaded error messages, and to propagate 111 -- the Error node if necessary. 112 113 ------------------------ 114 -- Current_Error_Node -- 115 ------------------------ 116 117 -- Current_Error_Node is a global variable indicating the current node 118 -- that is being processed for the purposes of placing a compiler 119 -- abort message. This is not necessarily perfectly accurate, it is 120 -- just a reasonably accurate best guess. It is used to output the 121 -- source location in the abort message by Comperr, and also to 122 -- implement the d3 debugging flag. 123 124 -- There are two ways this gets set. During parsing, when new source 125 -- nodes are being constructed by calls to New_Node and New_Entity, 126 -- either one of these calls sets Current_Error_Node to the newly 127 -- created node. During semantic analysis, this mechanism is not 128 -- used, and instead Current_Error_Node is set by the subprograms in 129 -- Debug_A that mark the start and end of analysis/expansion of a 130 -- node in the tree. 131 132 -- Current_Error_Node is also used for other purposes. See, for example, 133 -- Rtsfind. 134 135 Current_Error_Node : Node_Id := Empty; 136 -- Node to place compiler abort messages 137 138 ------------------ 139 -- Error Counts -- 140 ------------------ 141 142 -- The following variables denote the count of errors of various kinds 143 -- detected in the tree. Note that these might be more logically located in 144 -- Err_Vars, but we put it here to deal with licensing issues (we need this 145 -- to have the GPL exception licensing, since Check_Error_Detected can be 146 -- called from units with this licensing). 147 148 Serious_Errors_Detected : Nat := 0; 149 -- This is a count of errors that are serious enough to stop expansion, 150 -- and hence to prevent generation of an object file even if the 151 -- switch -gnatQ is set. Initialized to zero at the start of compilation. 152 -- Initialized for -gnatVa use, see comment above. 153 154 -- WARNING: There is a matching C declaration of this variable in fe.h 155 156 Total_Errors_Detected : Nat := 0; 157 -- Number of errors detected so far. Includes count of serious errors and 158 -- non-serious errors, so this value is always greater than or equal to the 159 -- Serious_Errors_Detected value. Initialized to zero at the start of 160 -- compilation. Initialized for -gnatVa use, see comment above. 161 162 Warnings_Detected : Nat := 0; 163 -- Number of warnings detected. Initialized to zero at the start of 164 -- compilation. Initialized for -gnatVa use, see comment above. This 165 -- count includes the count of style and info messages. 166 167 Warning_Info_Messages : Nat := 0; 168 -- Number of info messages generated as warnings. Info messages are never 169 -- treated as errors (whether from use of the pragma, or the compiler 170 -- switch -gnatwe). 171 172 Report_Info_Messages : Nat := 0; 173 -- Number of info messages generated as reports. Info messages are never 174 -- treated as errors (whether from use of the pragma, or the compiler 175 -- switch -gnatwe). Used under Spark_Mode to report proved checks. 176 177 Check_Messages : Nat := 0; 178 -- Number of check messages generated. Check messages are neither warnings 179 -- nor errors. 180 181 Warnings_Treated_As_Errors : Nat := 0; 182 -- Number of warnings changed into errors as a result of matching a pattern 183 -- given in a Warning_As_Error configuration pragma. 184 185 Configurable_Run_Time_Violations : Nat := 0; 186 -- Count of configurable run time violations so far. This is used to 187 -- suppress certain cascaded error messages when we know that we may not 188 -- have fully expanded some items, due to high integrity violations (e.g. 189 -- the use of constructs not permitted by the library in use, or improper 190 -- constructs in No_Run_Time mode). 191 192 procedure Check_Error_Detected; 193 -- When an anomaly is found in the tree, many semantic routines silently 194 -- bail out, assuming that the anomaly was caused by a previously detected 195 -- serious error (or configurable run time violation). This routine should 196 -- be called in these cases, and will raise an exception if no such error 197 -- has been detected. This ensures that the anomaly is never allowed to go 198 -- unnoticed in legal programs. 199 200 -------------------------------------------------- 201 -- Node Allocation and Modification Subprograms -- 202 -------------------------------------------------- 203 204 -- The following subprograms are used for constructing the tree in the 205 -- first place, and then for subsequent modifications as required. 206 207 procedure Initialize; 208 -- Called at the start of compilation to make the entries for Empty and 209 -- Error. 210 211 procedure Lock; 212 -- Called before the back end is invoked to lock the nodes table. 213 -- Also called after Unlock to relock. 214 215 procedure Unlock; 216 -- Unlocks nodes table, in cases where the back end needs to modify it 217 218 procedure Lock_Nodes; 219 -- Called to lock node modifications when assertions are enabled; without 220 -- assertions calling this subprogram has no effect. The initial state of 221 -- the lock is unlocked. 222 223 procedure Unlock_Nodes; 224 -- Called to unlock node modifications when assertions are enabled; if 225 -- assertions are not enabled calling this subprogram has no effect. 226 227 function Is_Entity (N : Node_Or_Entity_Id) return Boolean; 228 pragma Inline (Is_Entity); 229 -- Returns True if N is an entity 230 231 function New_Node 232 (New_Node_Kind : Node_Kind; 233 New_Sloc : Source_Ptr) return Node_Id; 234 -- Allocates a new node with the given node type and source location 235 -- values. Fields have defaults depending on their type: 236 237 -- Flag: False 238 -- Node_Id: Empty 239 -- List_Id: Empty 240 -- Elist_Id: No_Elist 241 -- Uint: No_Uint 242 -- 243 -- Name_Id, String_Id, Valid_Uint, Unat, Upos, Nonzero_Uint, Ureal: 244 -- No default. This means it is an error to call the getter before 245 -- calling the setter. 246 -- 247 -- The usual approach is to build a new node using this function and 248 -- then, using the value returned, use the Set_xxx functions to set 249 -- fields of the node as required. New_Node can only be used for 250 -- non-entity nodes, i.e. it never generates an extended node. 251 -- 252 -- If we are currently parsing, as indicated by a previous call to 253 -- Set_Comes_From_Source_Default (True), then this call also resets 254 -- the value of Current_Error_Node. 255 256 function New_Entity 257 (New_Node_Kind : Node_Kind; 258 New_Sloc : Source_Ptr) return Entity_Id; 259 -- Similar to New_Node, except that it is used only for entity nodes 260 -- and returns an extended node. 261 262 procedure Set_Comes_From_Source_Default (Default : Boolean); 263 -- Sets value of Comes_From_Source flag to be used in all subsequent 264 -- New_Node and New_Entity calls until another call to this procedure 265 -- changes the default. This value is set True during parsing and 266 -- False during semantic analysis. This is also used to determine 267 -- if New_Node and New_Entity should set Current_Error_Node. 268 269 function Get_Comes_From_Source_Default return Boolean; 270 pragma Inline (Get_Comes_From_Source_Default); 271 -- Gets the current value of the Comes_From_Source flag 272 273 procedure Preserve_Comes_From_Source (NewN, OldN : Node_Id); 274 pragma Inline (Preserve_Comes_From_Source); 275 -- When a node is rewritten, it is sometimes appropriate to preserve the 276 -- original comes from source indication. This is true when the rewrite 277 -- essentially corresponds to a transformation corresponding exactly to 278 -- semantics in the reference manual. This procedure copies the setting 279 -- of Comes_From_Source from OldN to NewN. 280 281 procedure Change_Node (N : Node_Id; New_Kind : Node_Kind); 282 -- This procedure replaces the given node by setting its Nkind field to the 283 -- indicated value and resetting all other fields to their default values 284 -- except for certain fields that are preserved (see body for details). 285 286 procedure Copy_Node (Source, Destination : Node_Or_Entity_Id); 287 -- Copy the entire contents of the source node to the destination node. 288 -- The contents of the source node is not affected. If the source node 289 -- has an extension, then the destination must have an extension also. 290 -- The parent pointer of the destination and its list link, if any, are 291 -- not affected by the copy. Note that parent pointers of descendants 292 -- are not adjusted, so the descendants of the destination node after 293 -- the Copy_Node is completed have dubious parent pointers. Note that 294 -- this routine does NOT copy aspect specifications, the Has_Aspects 295 -- flag in the returned node will always be False. The caller must deal 296 -- with copying aspect specifications where this is required. 297 298 function New_Copy (Source : Node_Id) return Node_Id; 299 -- This function allocates a new node, and then initializes it by copying 300 -- the contents of the source node into it. The contents of the source node 301 -- is not affected. The target node is always marked as not being in a list 302 -- (even if the source is a list member), and not overloaded. The new node 303 -- will have an extension if the source has an extension. New_Copy (Empty) 304 -- returns Empty, and New_Copy (Error) returns Error. Note that, unlike 305 -- Copy_Separate_Tree, New_Copy does not recursively copy any descendants, 306 -- so in general parent pointers are not set correctly for the descendants 307 -- of the copied node. Both normal and extended nodes (entities) may be 308 -- copied using New_Copy. 309 310 function Relocate_Node (Source : Node_Id) return Node_Id; 311 -- Source is a non-entity node that is to be relocated. A new node is 312 -- allocated, and the contents of Source are copied to this node, using 313 -- New_Copy. The parent pointers of descendants of the node are then 314 -- adjusted to point to the relocated copy. The original node is not 315 -- modified, but the parent pointers of its descendants are no longer 316 -- valid. The new copy is always marked as not overloaded. This routine is 317 -- used in conjunction with the tree rewrite routines (see descriptions of 318 -- Replace/Rewrite). 319 -- 320 -- Note that the resulting node has the same parent as the source node, and 321 -- is thus still attached to the tree. It is valid for Source to be Empty, 322 -- in which case Relocate_Node simply returns Empty as the result. 323 324 function Copy_Separate_Tree (Source : Node_Id) return Node_Id; 325 -- Given a node that is the root of a subtree, Copy_Separate_Tree copies 326 -- the entire syntactic subtree, including recursively any descendants 327 -- whose parent field references a copied node (descendants not linked to 328 -- a copied node by the parent field are also copied.) The parent pointers 329 -- in the copy are properly set. Copy_Separate_Tree (Empty/Error) returns 330 -- Empty/Error. The new subtree does not share entities with the source, 331 -- but has new entities with the same name. 332 -- 333 -- Most of the time this routine is called on an unanalyzed tree, and no 334 -- semantic information is copied. However, to ensure that no entities 335 -- are shared between the two when the source is already analyzed, and 336 -- that the result looks like an unanalyzed tree from the parser, Entity 337 -- fields and Etype fields are set to Empty, and Analyzed flags set False. 338 -- 339 -- In addition, Expanded_Name nodes are converted back into the original 340 -- parser form (where they are Selected_Components), so that reanalysis 341 -- does the right thing. 342 343 function Copy_Separate_List (Source : List_Id) return List_Id; 344 -- Applies Copy_Separate_Tree to each element of the Source list, returning 345 -- a new list of the results of these copy operations. 346 347 procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id); 348 -- Exchange the contents of two entities. The parent pointers are switched 349 -- as well as the Defining_Identifier fields in the parents, so that the 350 -- entities point correctly to their original parents. The effect is thus 351 -- to leave the tree unchanged in structure, except that the entity ID 352 -- values of the two entities are interchanged. Neither of the two entities 353 -- may be list members. Note that entities appear on two semantic chains: 354 -- Homonym and Next_Entity: the corresponding links must be adjusted by the 355 -- caller, according to context. 356 357 procedure Extend_Node (Source : Node_Id); 358 -- This turns a node into an entity; it function is used only by Sinfo.CN. 359 360 type Ignored_Ghost_Record_Proc is access procedure (N : Node_Or_Entity_Id); 361 362 procedure Set_Ignored_Ghost_Recording_Proc 363 (Proc : Ignored_Ghost_Record_Proc); 364 -- Register a procedure that is invoked when an ignored Ghost node or 365 -- entity is created. 366 367 type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id); 368 369 procedure Set_Reporting_Proc (Proc : Report_Proc); 370 -- Register a procedure that is invoked when a node is allocated, replaced 371 -- or rewritten. 372 373 type Rewrite_Proc is access procedure (Target : Node_Id; Source : Node_Id); 374 375 procedure Set_Rewriting_Proc (Proc : Rewrite_Proc); 376 -- Register a procedure that is invoked when a node is rewritten 377 378 type Traverse_Result is (Abandon, OK, OK_Orig, Skip); 379 -- This is the type of the result returned by the Process function passed 380 -- to Traverse_Func and Traverse_Proc. See below for details. 381 382 subtype Traverse_Final_Result is Traverse_Result range Abandon .. OK; 383 -- This is the type of the final result returned Traverse_Func, based on 384 -- the results of Process calls. See below for details. 385 386 generic 387 with function Process (N : Node_Id) return Traverse_Result is <>; 388 function Traverse_Func (Node : Node_Id) return Traverse_Final_Result; 389 -- This is a generic function that, given the parent node for a subtree, 390 -- traverses all syntactic nodes of this tree, calling the given function 391 -- Process on each one, in pre order (i.e. top-down). The order of 392 -- traversing subtrees is arbitrary. The traversal is controlled as follows 393 -- by the result returned by Process: 394 395 -- OK The traversal continues normally with the syntactic 396 -- children of the node just processed. 397 398 -- OK_Orig The traversal continues normally with the syntactic 399 -- children of the original node of the node just processed. 400 401 -- Skip The children of the node just processed are skipped and 402 -- excluded from the traversal, but otherwise processing 403 -- continues elsewhere in the tree. 404 405 -- Abandon The entire traversal is immediately abandoned, and the 406 -- original call to Traverse returns Abandon. 407 408 -- The result returned by Traverse is Abandon if processing was terminated 409 -- by a call to Process returning Abandon, otherwise it is OK (meaning that 410 -- all calls to process returned either OK, OK_Orig, or Skip). 411 412 generic 413 with function Process (N : Node_Id) return Traverse_Result is <>; 414 procedure Traverse_Proc (Node : Node_Id); 415 pragma Inline (Traverse_Proc); 416 -- This is the same as Traverse_Func except that no result is returned, 417 -- i.e. Traverse_Func is called and the result is simply discarded. 418 419 --------------------------- 420 -- Node Access Functions -- 421 --------------------------- 422 423 -- The following functions return the contents of the indicated field of 424 -- the node referenced by the argument, which is a Node_Id. 425 426 function No (N : Node_Id) return Boolean; 427 pragma Inline (No); 428 -- Tests given Id for equality with the Empty node. This allows notations 429 -- like "if No (Variant_Part)" as opposed to "if Variant_Part = Empty". 430 431 function Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id; 432 pragma Inline (Parent); 433 -- Returns the parent of a node if the node is not a list member, or else 434 -- the parent of the list containing the node if the node is a list member. 435 436 function Paren_Count (N : Node_Id) return Nat; 437 pragma Inline (Paren_Count); 438 -- Number of parentheses that surround an expression 439 440 function Present (N : Node_Id) return Boolean; 441 pragma Inline (Present); 442 -- Tests given Id for inequality with the Empty node. This allows notations 443 -- like "if Present (Statement)" as opposed to "if Statement /= Empty". 444 445 procedure Set_Original_Node (N : Node_Id; Val : Node_Id); 446 pragma Inline (Set_Original_Node); 447 -- Note that this routine is used only in very peculiar cases. In normal 448 -- cases, the Original_Node link is set by calls to Rewrite. 449 450 procedure Set_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id); 451 pragma Inline (Set_Parent); 452 453 procedure Set_Paren_Count (N : Node_Id; Val : Nat); 454 pragma Inline (Set_Paren_Count); 455 456 --------------------------- 457 -- Tree Rewrite Routines -- 458 --------------------------- 459 460 -- During the compilation process it is necessary in a number of situations 461 -- to rewrite the tree. In some cases, such rewrites do not affect the 462 -- structure of the tree, for example, when an indexed component node is 463 -- replaced by the corresponding call node (the parser cannot distinguish 464 -- between these two cases). 465 466 -- In other situations, the rewrite does affect the structure of the 467 -- tree. Examples are the replacement of a generic instantiation by the 468 -- instantiated spec and body, and the static evaluation of expressions. 469 470 -- If such structural modifications are done by the expander, there are 471 -- no difficulties, since the form of the tree after the expander has no 472 -- special significance, except as input to the backend of the compiler. 473 -- However, if these modifications are done by the semantic phase, then 474 -- it is important that they be done in a manner which allows the original 475 -- tree to be preserved. This is because tools like pretty printers need 476 -- to have this original tree structure available. 477 478 -- The subprograms in this section allow rewriting of the tree by either 479 -- insertion of new nodes in an existing list, or complete replacement of 480 -- a subtree. The resulting tree for most purposes looks as though it has 481 -- been really changed, and there is no trace of the original. However, 482 -- special subprograms, also defined in this section, allow the original 483 -- tree to be reconstructed if necessary. 484 485 -- For tree modifications done in the expander, it is permissible to 486 -- destroy the original tree, although it is also allowable to use the 487 -- tree rewrite routines where it is convenient to do so. 488 489 procedure Mark_Rewrite_Insertion (New_Node : Node_Id); 490 pragma Inline (Mark_Rewrite_Insertion); 491 -- This procedure marks the given node as an insertion made during a tree 492 -- rewriting operation. Only the root needs to be marked. The call does 493 -- not do the actual insertion, which must be done using one of the normal 494 -- list insertion routines. The node is treated normally in all respects 495 -- except for its response to Is_Rewrite_Insertion. The function of these 496 -- calls is to be able to get an accurate original tree. This helps the 497 -- accuracy of Sprint.Sprint_Node, and in particular, when stubs are being 498 -- generated, it is essential that the original tree be accurate. 499 500 function Is_Rewrite_Insertion (Node : Node_Id) return Boolean; 501 pragma Inline (Is_Rewrite_Insertion); 502 -- Tests whether the given node was marked using Mark_Rewrite_Insertion. 503 -- This is used in reconstructing the original tree (where such nodes are 504 -- to be eliminated). 505 506 procedure Rewrite (Old_Node, New_Node : Node_Id); 507 -- This is used when a complete subtree is to be replaced. Old_Node is the 508 -- root of the old subtree to be replaced, and New_Node is the root of the 509 -- newly constructed replacement subtree. The actual mechanism is to swap 510 -- the contents of these two nodes fixing up the parent pointers of the 511 -- replaced node (we do not attempt to preserve parent pointers for the 512 -- original node). Neither Old_Node nor New_Node can be extended nodes. 513 -- ??? The above explanation is incorrect, instead Copy_Node is called. 514 -- 515 -- Note: New_Node may not contain references to Old_Node, for example as 516 -- descendants, since the rewrite would make such references invalid. If 517 -- New_Node does need to reference Old_Node, then these references should 518 -- be to a relocated copy of Old_Node (see Relocate_Node procedure). 519 -- 520 -- Note: The Original_Node function applied to Old_Node (which has now 521 -- been replaced by the contents of New_Node), can be used to obtain the 522 -- original node, i.e. the old contents of Old_Node. 523 524 procedure Replace (Old_Node, New_Node : Node_Id); 525 -- This is similar to Rewrite, except that the old value of Old_Node 526 -- is not saved. New_Node should not be used after Replace. The flag 527 -- Is_Rewrite_Substitution will be False for the resulting node, unless 528 -- it was already true on entry, and Original_Node will not return the 529 -- original contents of the Old_Node, but rather the New_Node value. 530 -- Replace also preserves the setting of Comes_From_Source. 531 -- 532 -- Note that New_Node must not contain references to Old_Node, for example 533 -- as descendants, since the rewrite would make such references invalid. If 534 -- New_Node does need to reference Old_Node, then these references should 535 -- be to a relocated copy of Old_Node (see Relocate_Node procedure). 536 -- 537 -- Replace is used in certain circumstances where it is desirable to 538 -- suppress any history of the rewriting operation. Notably, it is used 539 -- when the parser has mis-classified a node (e.g. a task entry call 540 -- that the parser has parsed as a procedure call). 541 542 function Is_Rewrite_Substitution (Node : Node_Id) return Boolean; 543 pragma Inline (Is_Rewrite_Substitution); 544 -- Return True iff Node has been rewritten (i.e. if Node is the root 545 -- of a subtree which was installed using Rewrite). 546 547 function Original_Node (Node : Node_Id) return Node_Id; 548 pragma Inline (Original_Node); 549 -- If Node has not been rewritten, then returns its input argument 550 -- unchanged, else returns the Node for the original subtree. See section 551 -- in sinfo.ads for requirements on original nodes returned by this 552 -- function. 553 -- 554 -- Note: Parents are not preserved in original tree nodes that are 555 -- retrieved in this way (i.e. their children may have children whose 556 -- Parent pointers reference some other node). 557 -- 558 -- Note: there is no direct mechanism for deleting an original node (in 559 -- a manner that can be reversed later). One possible approach is to use 560 -- Rewrite to substitute a null statement for the node to be deleted. 561 562 ---------------------- 563 -- Vanishing Fields -- 564 ---------------------- 565 566 -- The Nkind and Ekind fields are like Ada discriminants governing a 567 -- variant part. They determine which fields are present. If the Nkind 568 -- or Ekind fields are changed, then this can change which fields are 569 -- present. If a field is present for the old kind, but not for the 570 -- new kind, the field vanishes. This requires some care when changing 571 -- kinds, as described below. Note that Ada doesn't even allow direct 572 -- modification of a discriminant. 573 574 type Node_Field_Set is array (Node_Field) of Boolean with Pack; 575 576 type Entity_Field_Set is array (Entity_Field) of Boolean with Pack; 577 578 procedure Reinit_Field_To_Zero (N : Node_Id; Field : Node_Or_Entity_Field); 579 -- When a node is created, all fields are initialized to zero, even if zero 580 -- is not a valid value of the field type. This procedure puts the field 581 -- back to its initial zero value. Note that you can't just do something 582 -- like Set_Some_Field (N, 0), if Some_Field is of (say) type Uintp, 583 -- because Uintp is a subrange that does not include 0. 584 type Entity_Kind_Set is array (Entity_Kind) of Boolean with Pack; 585 procedure Reinit_Field_To_Zero 586 (N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind_Set); 587 procedure Reinit_Field_To_Zero 588 (N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind); 589 -- Same as above, but assert that the old Ekind is as specified. We might 590 -- want to get rid of these, but it's useful documentation while working on 591 -- this. 592 593 function Field_Is_Initial_Zero 594 (N : Node_Id; Field : Node_Or_Entity_Field) return Boolean; 595 -- True if the field value is the initial zero value 596 597 procedure Mutate_Nkind (N : Node_Id; Val : Node_Kind) with Inline; 598 -- There is no Set_Nkind in Sinfo.Nodes. We use this instead. This is here, 599 -- and has a different name, because it does some extra checking. Nkind is 600 -- like a discriminant, in that it controls which fields exist, and that 601 -- set of fields can be different for the new kind. Discriminants cannot be 602 -- modified in Ada for that reason. The rule here is more flexible: Nkind 603 -- can be modified. However, when Nkind is modified, fields that exist for 604 -- the old kind, but not for the new kind will vanish. We require that all 605 -- vanishing fields be set to their initial zero value before calling 606 -- Mutate_Nkind. This is necessary, because the memory occupied by the 607 -- vanishing fields might be used for totally unrelated fields in the new 608 -- node. See Reinit_Field_To_Zero. 609 610 procedure Mutate_Ekind 611 (N : Entity_Id; Val : Entity_Kind) with Inline; 612 -- Ekind is also like a discriminant, and is mostly treated as above (see 613 -- Mutate_Nkind). However, there are a few cases where we set the Ekind 614 -- from its initial E_Void value to something else, then set it back to 615 -- E_Void, then back to the something else, and we expect the "something 616 -- else" fields to retain their value. The two "something else"s are not 617 -- always the same; for example we change from E_Void, to E_Variable, to 618 -- E_Void, to E_Constant. 619 620 function Node_To_Fetch_From 621 (N : Node_Or_Entity_Id; Field : Node_Or_Entity_Field) 622 return Node_Or_Entity_Id is 623 (case Field_Descriptors (Field).Type_Only is 624 when No_Type_Only => N, 625 when Base_Type_Only => Base_Type (N), 626 when Impl_Base_Type_Only => Implementation_Base_Type (N), 627 when Root_Type_Only => Root_Type (N)); 628 -- This is analogous to the same-named function in Gen_IL.Gen. Normally, 629 -- Type_Only is No_Type_Only, and we fetch the field from the node N. But 630 -- if Type_Only = Base_Type_Only, we need to go to the Base_Type, and 631 -- similarly for the other two cases. This can return something other 632 -- than N only if N is an Entity. 633 634 ----------------------------- 635 -- Private Part Subpackage -- 636 ----------------------------- 637 638 -- The following package contains the definition of the data structure 639 -- used by the implementation of the Atree package. Logically it really 640 -- corresponds to the private part, hence the name. The reason that it 641 -- is defined as a sub-package is to allow special access from clients 642 -- that need to see the internals of the data structures. 643 644 package Atree_Private_Part is 645 646 pragma Assert (Node_Kind'Pos (N_Unused_At_Start) = 0); 647 pragma Assert (Empty_List_Or_Node = 0); 648 pragma Assert (Entity_Kind'Pos (E_Void) = 0); 649 -- We want nodes initialized to zero bits by default 650 651 ------------------------- 652 -- Tree Representation -- 653 ------------------------- 654 655 -- The nodes of the tree are stored in two tables (i.e. growable 656 -- arrays). 657 658 -- A Node_Id points to an element of Node_Offsets, which contains a 659 -- Field_Offset that points to an element of Slots. Each slot can 660 -- contain a single 32-bit field, or multiple smaller fields. 661 -- An n-bit field is aligned on an n-bit boundary. The size of a node is 662 -- the number of slots, which can range from 1 up to however many are 663 -- needed. 664 -- 665 -- The reason for the extra level of indirection is that Copy_Node, 666 -- Exchange_Entities, and Rewrite all assume that nodes can be modified 667 -- in place. 668 -- 669 -- As an optimization, we store a few slots directly in the Node_Offsets 670 -- table (see type Node_Header) rather than requiring the extra level of 671 -- indirection for accessing those slots. N_Head is the number of slots 672 -- stored in the Node_Header. N_Head can be adjusted by modifying 673 -- Gen_IL.Gen. If N_Head is (say) 3, then a node containing 7 slots will 674 -- have slots 0..2 in the header, and 3..6 stored indirect in the Slots 675 -- table. We use zero-origin addressing, so the Offset into the Slots 676 -- table will point 3 slots before slot 3. 677 678 pragma Assert (N_Head <= Min_Node_Size); 679 pragma Assert (N_Head <= Min_Entity_Size); 680 681 Slot_Size : constant := 32; 682 type Slot is mod 2**Slot_Size; 683 for Slot'Size use Slot_Size; 684 685 -- The type Slot is defined in Types as a 32-bit modular integer. It 686 -- is logically split into the appropriate numbers of components of 687 -- appropriate size, but this splitting is not explicit because packed 688 -- arrays cannot be properly interfaced in C/C++ and packed records are 689 -- way too slow. 690 691 type Node_Header_Slots is 692 array (Field_Offset range 0 .. N_Head - 1) of Slot; 693 type Node_Header is record 694 Slots : Node_Header_Slots; 695 Offset : Node_Offset'Base; 696 end record; 697 pragma Assert (Node_Header'Size = (N_Head + 1) * Slot_Size); 698 pragma Assert (Node_Header'Size = 16 * 8); 699 700 package Node_Offsets is new Table.Table 701 (Table_Component_Type => Node_Header, 702 Table_Index_Type => Node_Id'Base, 703 Table_Low_Bound => First_Node_Id, 704 Table_Initial => Alloc.Node_Offsets_Initial, 705 Table_Increment => Alloc.Node_Offsets_Increment, 706 Table_Name => "Node_Offsets"); 707 708 Noff : Node_Offsets.Table_Ptr renames Node_Offsets.Table with 709 Unreferenced; 710 function Nlast return Node_Id'Base renames Node_Offsets.Last with 711 Unreferenced; 712 -- Short names for use in gdb, not used in real code. Note that gdb 713 -- can't find Node_Offsets.Table without a full expanded name. 714 715 function Shift_Left (S : Slot; V : Natural) return Slot; 716 pragma Import (Intrinsic, Shift_Left); 717 718 function Shift_Right (S : Slot; V : Natural) return Slot; 719 pragma Import (Intrinsic, Shift_Right); 720 721 -- Low-level types for fields of the various supported sizes. 722 -- All fields are a power of 2 number of bits, and are aligned 723 -- to that number of bits: 724 725 type Field_Size_1_Bit is mod 2**1; 726 type Field_Size_2_Bit is mod 2**2; 727 type Field_Size_4_Bit is mod 2**4; 728 type Field_Size_8_Bit is mod 2**8; 729 type Field_Size_32_Bit is mod 2**32; 730 731 Slots_Low_Bound : constant Field_Offset := Field_Offset'First + 1; 732 733 package Slots is new Table.Table 734 (Table_Component_Type => Slot, 735 Table_Index_Type => Node_Offset'Base, 736 Table_Low_Bound => Slots_Low_Bound, 737 Table_Initial => Alloc.Slots_Initial, 738 Table_Increment => Alloc.Slots_Increment, 739 Table_Name => "Slots"); 740 -- Note that Table_Low_Bound is set such that if we try to access 741 -- Slots.Table (0), we will get Constraint_Error. 742 743 Slts : Slots.Table_Ptr renames Slots.Table with 744 Unreferenced; 745 function Slast return Node_Offset'Base renames Slots.Last with 746 Unreferenced; 747 -- Short names for use in gdb, not used in real code. Note that gdb 748 -- can't find Slots.Table without a full expanded name. 749 750 function Alloc_Node_Id return Node_Id with Inline; 751 752 function Alloc_Slots (Num_Slots : Slot_Count) return Node_Offset 753 with Inline; 754 -- Allocate the slots for a node in the Slots table 755 756 -- Each of the following Get_N_Bit_Field functions fetches the field of 757 -- the given Field_Type at the given offset. Field_Type'Size must be N. 758 -- The offset is measured in units of Field_Type'Size. Likewise for the 759 -- Set_N_Bit_Field procedures. These are instantiated in Sinfo.Nodes and 760 -- Einfo.Entities for the various possible Field_Types (Flag, Node_Id, 761 -- Uint, etc). 762 763 generic 764 type Field_Type is private; 765 function Get_1_Bit_Field 766 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type 767 with Inline; 768 769 generic 770 type Field_Type is private; 771 function Get_2_Bit_Field 772 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type 773 with Inline; 774 775 generic 776 type Field_Type is private; 777 function Get_4_Bit_Field 778 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type 779 with Inline; 780 781 generic 782 type Field_Type is private; 783 function Get_8_Bit_Field 784 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type 785 with Inline; 786 787 generic 788 type Field_Type is private; 789 function Get_32_Bit_Field 790 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type 791 with Inline; 792 793 generic 794 type Field_Type is private; 795 Default_Val : Field_Type; 796 function Get_32_Bit_Field_With_Default 797 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type 798 with Inline; 799 -- If the field has not yet been set, return Default_Val 800 801 generic 802 type Field_Type is private; 803 function Get_Valid_32_Bit_Field 804 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type 805 with Inline; 806 -- Assert that the field has already been set. This is currently used 807 -- only for Uints, but could be used more generally. 808 809 generic 810 type Field_Type is private; 811 procedure Set_1_Bit_Field 812 (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) 813 with Inline; 814 815 generic 816 type Field_Type is private; 817 procedure Set_2_Bit_Field 818 (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) 819 with Inline; 820 821 generic 822 type Field_Type is private; 823 procedure Set_4_Bit_Field 824 (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) 825 with Inline; 826 827 generic 828 type Field_Type is private; 829 procedure Set_8_Bit_Field 830 (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) 831 with Inline; 832 833 generic 834 type Field_Type is private; 835 procedure Set_32_Bit_Field 836 (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) 837 with Inline; 838 839 -- The following are similar to the above generics, but are not generic, 840 -- and work with the low-level Field_n_bit types. If generics could be 841 -- overloaded, we would use the same names. 842 843 function Get_1_Bit_Val 844 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_1_Bit 845 with Inline; 846 847 function Get_2_Bit_Val 848 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_2_Bit 849 with Inline; 850 851 function Get_4_Bit_Val 852 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_4_Bit 853 with Inline; 854 855 function Get_8_Bit_Val 856 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_8_Bit 857 with Inline; 858 859 function Get_32_Bit_Val 860 (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_32_Bit 861 with Inline; 862 863 procedure Set_1_Bit_Val 864 (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_1_Bit) 865 with Inline; 866 867 procedure Set_2_Bit_Val 868 (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_2_Bit) 869 with Inline; 870 871 procedure Set_4_Bit_Val 872 (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_4_Bit) 873 with Inline; 874 875 procedure Set_8_Bit_Val 876 (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_8_Bit) 877 with Inline; 878 879 procedure Set_32_Bit_Val 880 (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_32_Bit) 881 with Inline; 882 883 -- The following are used in "asserts on" mode to validate nodes; an 884 -- exception is raised if invalid node content is detected. 885 886 procedure Validate_Node (N : Node_Or_Entity_Id); 887 -- Validate for reading 888 procedure Validate_Node_Write (N : Node_Or_Entity_Id); 889 -- Validate for writing 890 891 function Is_Valid_Node (U : Union_Id) return Boolean; 892 -- True if U is within the range of Node_Offsets 893 894 procedure Print_Atree_Info (N : Node_Or_Entity_Id); 895 -- Called from Treepr to print out information about N that is private 896 -- to Atree. 897 898 end Atree_Private_Part; 899 900 -- Statistics: 901 902 subtype Call_Count is Nat_64; 903 Get_Count, Set_Count : array (Node_Or_Entity_Field) of Call_Count := 904 (others => 0); 905 -- Number of calls to each getter and setter. See documentaton for 906 -- -gnatd.A. 907 908 Get_Original_Node_Count, Set_Original_Node_Count : Call_Count := 0; 909 910 procedure Print_Statistics; 911 912end Atree; 913