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