blob: c239507c93cfb3432fb8b30ee6bc6d6fc3c54ff7 [file] [log] [blame]
-- --
-- --
-- A T R E E --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
-- This package defines the low-level representation of the tree used to
-- represent the Ada program internally. Syntactic and semantic information
-- is combined in this tree. There is no separate symbol table structure.
-- WARNING: There is a C++ version of this package. Any changes to this source
-- file must be properly reflected in the C++ header file atree.h.
-- Package Atree defines the basic structure of the tree and its nodes and
-- provides the basic abstract interface for manipulating the tree. Two other
-- packages use this interface to define the representation of Ada programs
-- using this tree format. The package Sinfo defines the basic representation
-- of the syntactic structure of the program, as output by the parser. The
-- package Einfo defines the semantic information that is added to the tree
-- nodes that represent declared entities (i.e. the information that is
-- described in a separate symbol table structure in some other compilers).
-- The front end of the compiler first parses the program and generates a
-- tree that is simply a syntactic representation of the program in abstract
-- syntax tree format. Subsequent processing in the front end traverses the
-- tree, transforming it in various ways and adding semantic information.
with Alloc;
with Sinfo.Nodes; use Sinfo.Nodes;
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
with Types; use Types;
with Seinfo; use Seinfo;
with System; use System;
with Table;
with Unchecked_Conversion;
package Atree is
-- Access to node fields is generally done through the getters and setters
-- in packages Sinfo.Nodes and Einfo.Entities, which are automatically
-- generated (see Gen_IL.Gen). However, in specialized circumstances
-- (examples are the circuit in generic instantiation to copy trees, and in
-- the tree dump routine), it is useful to be able to do untyped
-- traversals, and an internal package in Atree allows for direct untyped
-- accesses in such cases.
function Last_Node_Id return Node_Id;
-- Returns Id of last allocated node Id
function Node_Offsets_Address return System.Address;
function Slots_Address return System.Address;
-- Address of Node_Offsets.Table and Slots.Table. Used in Back_End for Gigi
-- call.
function Approx_Num_Nodes_And_Entities return Nat;
-- This is an approximation to the number of nodes and entities allocated,
-- used to determine sizes of hash tables.
-- Use of Empty Node --
-- The special Node_Id Empty is used to mark missing fields, similar to
-- "null" in Ada. Whenever the syntax has an optional component, then the
-- corresponding field will be set to Empty if the component is missing.
-- Note: Empty is not used to describe an empty list. Instead in this
-- case the node field contains a list which is empty, and these cases
-- should be distinguished (essentially from a type point of view, Empty
-- is a Node, not a list).
-- Note: Empty does in fact correspond to an allocated node. The Nkind
-- field of this node may be referenced. It contains N_Empty, which
-- uniquely identifies the empty case. This allows the Nkind field to be
-- dereferenced before the check for Empty which is sometimes useful. We
-- also access certain other fields of Empty; see comments in
-- Gen_IL.Gen.Gen_Nodes.
-- Use of Error Node --
-- The Error node is used during syntactic and semantic analysis to
-- indicate that the corresponding piece of syntactic structure or
-- semantic meaning cannot properly be represented in the tree because
-- of an illegality in the program.
-- If an Error node is encountered, then you know that a previous
-- illegality has been detected. The proper reaction should be to
-- avoid posting related cascaded error messages, and to propagate
-- the Error node if necessary.
-- Current_Error_Node --
-- Current_Error_Node is a global variable indicating the current node
-- that is being processed for the purposes of placing a compiler
-- abort message. This is not necessarily perfectly accurate, it is
-- just a reasonably accurate best guess. It is used to output the
-- source location in the abort message by Comperr, and also to
-- implement the d3 debugging flag.
-- There are two ways this gets set. During parsing, when new source
-- nodes are being constructed by calls to New_Node and New_Entity,
-- either one of these calls sets Current_Error_Node to the newly
-- created node. During semantic analysis, this mechanism is not
-- used, and instead Current_Error_Node is set by the subprograms in
-- Debug_A that mark the start and end of analysis/expansion of a
-- node in the tree.
-- Current_Error_Node is also used for other purposes. See, for example,
-- Rtsfind.
Current_Error_Node : Node_Id := Empty;
-- Node to place compiler abort messages
-- Error Counts --
-- The following variables denote the count of errors of various kinds
-- detected in the tree. Note that these might be more logically located in
-- Err_Vars, but we put it here to deal with licensing issues (we need this
-- to have the GPL exception licensing, since Check_Error_Detected can be
-- called from units with this licensing).
Serious_Errors_Detected : Nat := 0;
-- This is a count of errors that are serious enough to stop expansion,
-- and hence to prevent generation of an object file even if the
-- switch -gnatQ is set. Initialized to zero at the start of compilation.
-- Initialized for -gnatVa use, see comment above.
-- WARNING: There is a matching C declaration of this variable in fe.h
Total_Errors_Detected : Nat := 0;
-- Number of errors detected so far. Includes count of serious errors and
-- non-serious errors, so this value is always greater than or equal to the
-- Serious_Errors_Detected value. Initialized to zero at the start of
-- compilation. Initialized for -gnatVa use, see comment above.
Warnings_Detected : Nat := 0;
-- Number of warnings detected. Initialized to zero at the start of
-- compilation. Initialized for -gnatVa use, see comment above. This
-- count includes the count of style and info messages.
Warning_Info_Messages : Nat := 0;
-- Number of info messages generated as warnings. Info messages are never
-- treated as errors (whether from use of the pragma, or the compiler
-- switch -gnatwe).
Report_Info_Messages : Nat := 0;
-- Number of info messages generated as reports. Info messages are never
-- treated as errors (whether from use of the pragma, or the compiler
-- switch -gnatwe). Used under Spark_Mode to report proved checks.
Check_Messages : Nat := 0;
-- Number of check messages generated. Check messages are neither warnings
-- nor errors.
Warnings_Treated_As_Errors : Nat := 0;
-- Number of warnings changed into errors as a result of matching a pattern
-- given in a Warning_As_Error configuration pragma.
Configurable_Run_Time_Violations : Nat := 0;
-- Count of configurable run time violations so far. This is used to
-- suppress certain cascaded error messages when we know that we may not
-- have fully expanded some items, due to high integrity violations (e.g.
-- the use of constructs not permitted by the library in use, or improper
-- constructs in No_Run_Time mode).
procedure Check_Error_Detected;
-- When an anomaly is found in the tree, many semantic routines silently
-- bail out, assuming that the anomaly was caused by a previously detected
-- serious error (or configurable run time violation). This routine should
-- be called in these cases, and will raise an exception if no such error
-- has been detected. This ensures that the anomaly is never allowed to go
-- unnoticed in legal programs.
-- Node Allocation and Modification Subprograms --
-- The following subprograms are used for constructing the tree in the
-- first place, and then for subsequent modifications as required.
procedure Initialize;
-- Called at the start of compilation to make the entries for Empty and
-- Error.
procedure Lock;
-- Called before the back end is invoked to lock the nodes table.
-- Also called after Unlock to relock.
procedure Unlock;
-- Unlocks nodes table, in cases where the back end needs to modify it
procedure Lock_Nodes;
-- Called to lock node modifications when assertions are enabled; without
-- assertions calling this subprogram has no effect. The initial state of
-- the lock is unlocked.
procedure Unlock_Nodes;
-- Called to unlock node modifications when assertions are enabled; if
-- assertions are not enabled calling this subprogram has no effect.
function Is_Entity (N : Node_Or_Entity_Id) return Boolean;
pragma Inline (Is_Entity);
-- Returns True if N is an entity
function New_Node
(New_Node_Kind : Node_Kind;
New_Sloc : Source_Ptr) return Node_Id;
-- Allocates a new node with the given node type and source location
-- values. Fields have defaults depending on their type:
-- Flag: False
-- Node_Id: Empty
-- List_Id: Empty
-- Elist_Id: No_Elist
-- Uint: No_Uint
-- Name_Id, String_Id, Valid_Uint, Unat, Upos, Nonzero_Uint, Ureal:
-- No default. This means it is an error to call the getter before
-- calling the setter.
-- The usual approach is to build a new node using this function and
-- then, using the value returned, use the Set_xxx functions to set
-- fields of the node as required. New_Node can only be used for
-- non-entity nodes, i.e. it never generates an extended node.
-- If we are currently parsing, as indicated by a previous call to
-- Set_Comes_From_Source_Default (True), then this call also resets
-- the value of Current_Error_Node.
function New_Entity
(New_Node_Kind : Node_Kind;
New_Sloc : Source_Ptr) return Entity_Id;
-- Similar to New_Node, except that it is used only for entity nodes
-- and returns an extended node.
procedure Set_Comes_From_Source_Default (Default : Boolean);
-- Sets value of Comes_From_Source flag to be used in all subsequent
-- New_Node and New_Entity calls until another call to this procedure
-- changes the default. This value is set True during parsing and
-- False during semantic analysis. This is also used to determine
-- if New_Node and New_Entity should set Current_Error_Node.
function Get_Comes_From_Source_Default return Boolean;
pragma Inline (Get_Comes_From_Source_Default);
-- Gets the current value of the Comes_From_Source flag
procedure Preserve_Comes_From_Source (NewN, OldN : Node_Id);
pragma Inline (Preserve_Comes_From_Source);
-- When a node is rewritten, it is sometimes appropriate to preserve the
-- original comes from source indication. This is true when the rewrite
-- essentially corresponds to a transformation corresponding exactly to
-- semantics in the reference manual. This procedure copies the setting
-- of Comes_From_Source from OldN to NewN.
procedure Change_Node (N : Node_Id; New_Kind : Node_Kind);
-- This procedure replaces the given node by setting its Nkind field to the
-- indicated value and resetting all other fields to their default values
-- except for certain fields that are preserved (see body for details).
procedure Copy_Node (Source, Destination : Node_Or_Entity_Id);
-- Copy the entire contents of the source node to the destination node.
-- The contents of the source node is not affected. If the source node
-- has an extension, then the destination must have an extension also.
-- The parent pointer of the destination and its list link, if any, are
-- not affected by the copy. Note that parent pointers of descendants
-- are not adjusted, so the descendants of the destination node after
-- the Copy_Node is completed have dubious parent pointers. Note that
-- this routine does NOT copy aspect specifications, the Has_Aspects
-- flag in the returned node will always be False. The caller must deal
-- with copying aspect specifications where this is required.
function New_Copy (Source : Node_Id) return Node_Id;
-- This function allocates a new node, and then initializes it by copying
-- the contents of the source node into it. The contents of the source node
-- is not affected. The target node is always marked as not being in a list
-- (even if the source is a list member), and not overloaded. The new node
-- will have an extension if the source has an extension. New_Copy (Empty)
-- returns Empty, and New_Copy (Error) returns Error. Note that, unlike
-- Copy_Separate_Tree, New_Copy does not recursively copy any descendants,
-- so in general parent pointers are not set correctly for the descendants
-- of the copied node. Both normal and extended nodes (entities) may be
-- copied using New_Copy.
function Relocate_Node (Source : Node_Id) return Node_Id;
-- Source is a non-entity node that is to be relocated. A new node is
-- allocated, and the contents of Source are copied to this node, using
-- New_Copy. The parent pointers of descendants of the node are then
-- adjusted to point to the relocated copy. The original node is not
-- modified, but the parent pointers of its descendants are no longer
-- valid. The new copy is always marked as not overloaded. This routine is
-- used in conjunction with the tree rewrite routines (see descriptions of
-- Replace/Rewrite).
-- Note that the resulting node has the same parent as the source node, and
-- is thus still attached to the tree. It is valid for Source to be Empty,
-- in which case Relocate_Node simply returns Empty as the result.
function Copy_Separate_Tree (Source : Node_Id) return Node_Id;
-- Given a node that is the root of a subtree, Copy_Separate_Tree copies
-- the entire syntactic subtree, including recursively any descendants
-- whose parent field references a copied node (descendants not linked to
-- a copied node by the parent field are also copied.) The parent pointers
-- in the copy are properly set. Copy_Separate_Tree (Empty/Error) returns
-- Empty/Error. The new subtree does not share entities with the source,
-- but has new entities with the same name.
-- Most of the time this routine is called on an unanalyzed tree, and no
-- semantic information is copied. However, to ensure that no entities
-- are shared between the two when the source is already analyzed, and
-- that the result looks like an unanalyzed tree from the parser, Entity
-- fields and Etype fields are set to Empty, and Analyzed flags set False.
-- In addition, Expanded_Name nodes are converted back into the original
-- parser form (where they are Selected_Components), so that reanalysis
-- does the right thing.
function Copy_Separate_List (Source : List_Id) return List_Id;
-- Applies Copy_Separate_Tree to each element of the Source list, returning
-- a new list of the results of these copy operations.
procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id);
-- Exchange the contents of two entities. The parent pointers are switched
-- as well as the Defining_Identifier fields in the parents, so that the
-- entities point correctly to their original parents. The effect is thus
-- to leave the tree unchanged in structure, except that the entity ID
-- values of the two entities are interchanged. Neither of the two entities
-- may be list members. Note that entities appear on two semantic chains:
-- Homonym and Next_Entity: the corresponding links must be adjusted by the
-- caller, according to context.
procedure Extend_Node (Source : Node_Id);
-- This turns a node into an entity; it function is used only by Sinfo.CN.
type Ignored_Ghost_Record_Proc is access procedure (N : Node_Or_Entity_Id);
procedure Set_Ignored_Ghost_Recording_Proc
(Proc : Ignored_Ghost_Record_Proc);
-- Register a procedure that is invoked when an ignored Ghost node or
-- entity is created.
type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id);
procedure Set_Reporting_Proc (Proc : Report_Proc);
-- Register a procedure that is invoked when a node is allocated, replaced
-- or rewritten.
type Rewrite_Proc is access procedure (Target : Node_Id; Source : Node_Id);
procedure Set_Rewriting_Proc (Proc : Rewrite_Proc);
-- Register a procedure that is invoked when a node is rewritten
type Traverse_Result is (Abandon, OK, OK_Orig, Skip);
-- This is the type of the result returned by the Process function passed
-- to Traverse_Func and Traverse_Proc. See below for details.
subtype Traverse_Final_Result is Traverse_Result range Abandon .. OK;
-- This is the type of the final result returned Traverse_Func, based on
-- the results of Process calls. See below for details.
with function Process (N : Node_Id) return Traverse_Result is <>;
function Traverse_Func (Node : Node_Id) return Traverse_Final_Result;
-- This is a generic function that, given the parent node for a subtree,
-- traverses all syntactic nodes of this tree, calling the given function
-- Process on each one, in pre order (i.e. top-down). The order of
-- traversing subtrees is arbitrary. The traversal is controlled as follows
-- by the result returned by Process:
-- OK The traversal continues normally with the syntactic
-- children of the node just processed.
-- OK_Orig The traversal continues normally with the syntactic
-- children of the original node of the node just processed.
-- Skip The children of the node just processed are skipped and
-- excluded from the traversal, but otherwise processing
-- continues elsewhere in the tree.
-- Abandon The entire traversal is immediately abandoned, and the
-- original call to Traverse returns Abandon.
-- The result returned by Traverse is Abandon if processing was terminated
-- by a call to Process returning Abandon, otherwise it is OK (meaning that
-- all calls to process returned either OK, OK_Orig, or Skip).
with function Process (N : Node_Id) return Traverse_Result is <>;
procedure Traverse_Proc (Node : Node_Id);
pragma Inline (Traverse_Proc);
-- This is the same as Traverse_Func except that no result is returned,
-- i.e. Traverse_Func is called and the result is simply discarded.
-- Node Access Functions --
-- The following functions return the contents of the indicated field of
-- the node referenced by the argument, which is a Node_Id.
function No (N : Node_Id) return Boolean;
pragma Inline (No);
-- Tests given Id for equality with the Empty node. This allows notations
-- like "if No (Variant_Part)" as opposed to "if Variant_Part = Empty".
function Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id;
pragma Inline (Parent);
-- Returns the parent of a node if the node is not a list member, or else
-- the parent of the list containing the node if the node is a list member.
function Paren_Count (N : Node_Id) return Nat;
pragma Inline (Paren_Count);
-- Number of parentheses that surround an expression
function Present (N : Node_Id) return Boolean;
pragma Inline (Present);
-- Tests given Id for inequality with the Empty node. This allows notations
-- like "if Present (Statement)" as opposed to "if Statement /= Empty".
procedure Set_Original_Node (N : Node_Id; Val : Node_Id);
pragma Inline (Set_Original_Node);
-- Note that this routine is used only in very peculiar cases. In normal
-- cases, the Original_Node link is set by calls to Rewrite.
procedure Set_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id);
pragma Inline (Set_Parent);
procedure Set_Paren_Count (N : Node_Id; Val : Nat);
pragma Inline (Set_Paren_Count);
-- Tree Rewrite Routines --
-- During the compilation process it is necessary in a number of situations
-- to rewrite the tree. In some cases, such rewrites do not affect the
-- structure of the tree, for example, when an indexed component node is
-- replaced by the corresponding call node (the parser cannot distinguish
-- between these two cases).
-- In other situations, the rewrite does affect the structure of the
-- tree. Examples are the replacement of a generic instantiation by the
-- instantiated spec and body, and the static evaluation of expressions.
-- If such structural modifications are done by the expander, there are
-- no difficulties, since the form of the tree after the expander has no
-- special significance, except as input to the backend of the compiler.
-- However, if these modifications are done by the semantic phase, then
-- it is important that they be done in a manner which allows the original
-- tree to be preserved. This is because tools like pretty printers need
-- to have this original tree structure available.
-- The subprograms in this section allow rewriting of the tree by either
-- insertion of new nodes in an existing list, or complete replacement of
-- a subtree. The resulting tree for most purposes looks as though it has
-- been really changed, and there is no trace of the original. However,
-- special subprograms, also defined in this section, allow the original
-- tree to be reconstructed if necessary.
-- For tree modifications done in the expander, it is permissible to
-- destroy the original tree, although it is also allowable to use the
-- tree rewrite routines where it is convenient to do so.
procedure Mark_Rewrite_Insertion (New_Node : Node_Id);
pragma Inline (Mark_Rewrite_Insertion);
-- This procedure marks the given node as an insertion made during a tree
-- rewriting operation. Only the root needs to be marked. The call does
-- not do the actual insertion, which must be done using one of the normal
-- list insertion routines. The node is treated normally in all respects
-- except for its response to Is_Rewrite_Insertion. The function of these
-- calls is to be able to get an accurate original tree. This helps the
-- accuracy of Sprint.Sprint_Node, and in particular, when stubs are being
-- generated, it is essential that the original tree be accurate.
function Is_Rewrite_Insertion (Node : Node_Id) return Boolean;
pragma Inline (Is_Rewrite_Insertion);
-- Tests whether the given node was marked using Mark_Rewrite_Insertion.
-- This is used in reconstructing the original tree (where such nodes are
-- to be eliminated).
procedure Rewrite (Old_Node, New_Node : Node_Id);
-- This is used when a complete subtree is to be replaced. Old_Node is the
-- root of the old subtree to be replaced, and New_Node is the root of the
-- newly constructed replacement subtree. The actual mechanism is to swap
-- the contents of these two nodes fixing up the parent pointers of the
-- replaced node (we do not attempt to preserve parent pointers for the
-- original node). Neither Old_Node nor New_Node can be extended nodes.
-- ??? The above explanation is incorrect, instead Copy_Node is called.
-- Note: New_Node may not contain references to Old_Node, for example as
-- descendants, since the rewrite would make such references invalid. If
-- New_Node does need to reference Old_Node, then these references should
-- be to a relocated copy of Old_Node (see Relocate_Node procedure).
-- Note: The Original_Node function applied to Old_Node (which has now
-- been replaced by the contents of New_Node), can be used to obtain the
-- original node, i.e. the old contents of Old_Node.
procedure Replace (Old_Node, New_Node : Node_Id);
-- This is similar to Rewrite, except that the old value of Old_Node
-- is not saved. New_Node should not be used after Replace. The flag
-- Is_Rewrite_Substitution will be False for the resulting node, unless
-- it was already true on entry, and Original_Node will not return the
-- original contents of the Old_Node, but rather the New_Node value.
-- Replace also preserves the setting of Comes_From_Source.
-- Note that New_Node must not contain references to Old_Node, for example
-- as descendants, since the rewrite would make such references invalid. If
-- New_Node does need to reference Old_Node, then these references should
-- be to a relocated copy of Old_Node (see Relocate_Node procedure).
-- Replace is used in certain circumstances where it is desirable to
-- suppress any history of the rewriting operation. Notably, it is used
-- when the parser has mis-classified a node (e.g. a task entry call
-- that the parser has parsed as a procedure call).
function Is_Rewrite_Substitution (Node : Node_Id) return Boolean;
pragma Inline (Is_Rewrite_Substitution);
-- Return True iff Node has been rewritten (i.e. if Node is the root
-- of a subtree which was installed using Rewrite).
function Original_Node (Node : Node_Id) return Node_Id;
pragma Inline (Original_Node);
-- If Node has not been rewritten, then returns its input argument
-- unchanged, else returns the Node for the original subtree. See section
-- in for requirements on original nodes returned by this
-- function.
-- Note: Parents are not preserved in original tree nodes that are
-- retrieved in this way (i.e. their children may have children whose
-- Parent pointers reference some other node).
-- Note: there is no direct mechanism for deleting an original node (in
-- a manner that can be reversed later). One possible approach is to use
-- Rewrite to substitute a null statement for the node to be deleted.
-- Vanishing Fields --
-- The Nkind and Ekind fields are like Ada discriminants governing a
-- variant part. They determine which fields are present. If the Nkind
-- or Ekind fields are changed, then this can change which fields are
-- present. If a field is present for the old kind, but not for the
-- new kind, the field vanishes. This requires some care when changing
-- kinds, as described below. Note that Ada doesn't even allow direct
-- modification of a discriminant.
type Node_Field_Set is array (Node_Field) of Boolean with Pack;
type Entity_Field_Set is array (Entity_Field) of Boolean with Pack;
procedure Reinit_Field_To_Zero (N : Node_Id; Field : Node_Or_Entity_Field);
-- When a node is created, all fields are initialized to zero, even if zero
-- is not a valid value of the field type. This procedure puts the field
-- back to its initial zero value. Note that you can't just do something
-- like Set_Some_Field (N, 0), if Some_Field is of (say) type Uintp,
-- because Uintp is a subrange that does not include 0.
type Entity_Kind_Set is array (Entity_Kind) of Boolean with Pack;
procedure Reinit_Field_To_Zero
(N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind_Set);
procedure Reinit_Field_To_Zero
(N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind);
-- Same as above, but assert that the old Ekind is as specified. We might
-- want to get rid of these, but it's useful documentation while working on
-- this.
function Field_Is_Initial_Zero
(N : Node_Id; Field : Node_Or_Entity_Field) return Boolean;
-- True if the field value is the initial zero value
procedure Mutate_Nkind (N : Node_Id; Val : Node_Kind) with Inline;
-- There is no Set_Nkind in Sinfo.Nodes. We use this instead. This is here,
-- and has a different name, because it does some extra checking. Nkind is
-- like a discriminant, in that it controls which fields exist, and that
-- set of fields can be different for the new kind. Discriminants cannot be
-- modified in Ada for that reason. The rule here is more flexible: Nkind
-- can be modified. However, when Nkind is modified, fields that exist for
-- the old kind, but not for the new kind will vanish. We require that all
-- vanishing fields be set to their initial zero value before calling
-- Mutate_Nkind. This is necessary, because the memory occupied by the
-- vanishing fields might be used for totally unrelated fields in the new
-- node. See Reinit_Field_To_Zero.
procedure Mutate_Ekind
(N : Entity_Id; Val : Entity_Kind) with Inline;
-- Ekind is also like a discriminant, and is mostly treated as above (see
-- Mutate_Nkind). However, there are a few cases where we set the Ekind
-- from its initial E_Void value to something else, then set it back to
-- E_Void, then back to the something else, and we expect the "something
-- else" fields to retain their value. The two "something else"s are not
-- always the same; for example we change from E_Void, to E_Variable, to
-- E_Void, to E_Constant.
function Node_To_Fetch_From
(N : Node_Or_Entity_Id; Field : Node_Or_Entity_Field)
return Node_Or_Entity_Id is
(case Field_Descriptors (Field).Type_Only is
when No_Type_Only => N,
when Base_Type_Only => Base_Type (N),
when Impl_Base_Type_Only => Implementation_Base_Type (N),
when Root_Type_Only => Root_Type (N));
-- This is analogous to the same-named function in Gen_IL.Gen. Normally,
-- Type_Only is No_Type_Only, and we fetch the field from the node N. But
-- if Type_Only = Base_Type_Only, we need to go to the Base_Type, and
-- similarly for the other two cases. This can return something other
-- than N only if N is an Entity.
-- Private Part Subpackage --
-- The following package contains the definition of the data structure
-- used by the implementation of the Atree package. Logically it really
-- corresponds to the private part, hence the name. The reason that it
-- is defined as a sub-package is to allow special access from clients
-- that need to see the internals of the data structures.
package Atree_Private_Part is
pragma Assert (Node_Kind'Pos (N_Unused_At_Start) = 0);
pragma Assert (Empty_List_Or_Node = 0);
pragma Assert (Entity_Kind'Pos (E_Void) = 0);
-- We want nodes initialized to zero bits by default
-- Tree Representation --
-- The nodes of the tree are stored in two tables (i.e. growable
-- arrays).
-- A Node_Id points to an element of Node_Offsets, which contains a
-- Field_Offset that points to an element of Slots. Each slot can
-- contain a single 32-bit field, or multiple smaller fields.
-- An n-bit field is aligned on an n-bit boundary. The size of a node is
-- the number of slots, which can range from 1 up to however many are
-- needed.
-- The reason for the extra level of indirection is that Copy_Node,
-- Exchange_Entities, and Rewrite all assume that nodes can be modified
-- in place.
-- As an optimization, we store a few slots directly in the Node_Offsets
-- table (see type Node_Header) rather than requiring the extra level of
-- indirection for accessing those slots. N_Head is the number of slots
-- stored in the Node_Header. N_Head can be adjusted by modifying
-- Gen_IL.Gen. If N_Head is (say) 3, then a node containing 7 slots will
-- have slots 0..2 in the header, and 3..6 stored indirect in the Slots
-- table. We use zero-origin addressing, so the Offset into the Slots
-- table will point 3 slots before slot 3.
pragma Assert (N_Head <= Min_Node_Size);
pragma Assert (N_Head <= Min_Entity_Size);
Slot_Size : constant := 32;
type Slot is mod 2**Slot_Size;
for Slot'Size use Slot_Size;
-- The type Slot is defined in Types as a 32-bit modular integer. It
-- is logically split into the appropriate numbers of components of
-- appropriate size, but this splitting is not explicit because packed
-- arrays cannot be properly interfaced in C/C++ and packed records are
-- way too slow.
type Node_Header_Slots is
array (Field_Offset range 0 .. N_Head - 1) of Slot;
type Node_Header is record
Slots : Node_Header_Slots;
Offset : Node_Offset'Base;
end record;
pragma Assert (Node_Header'Size = (N_Head + 1) * Slot_Size);
pragma Assert (Node_Header'Size = 16 * 8);
package Node_Offsets is new Table.Table
(Table_Component_Type => Node_Header,
Table_Index_Type => Node_Id'Base,
Table_Low_Bound => First_Node_Id,
Table_Initial => Alloc.Node_Offsets_Initial,
Table_Increment => Alloc.Node_Offsets_Increment,
Table_Name => "Node_Offsets");
Noff : Node_Offsets.Table_Ptr renames Node_Offsets.Table with
function Nlast return Node_Id'Base renames Node_Offsets.Last with
-- Short names for use in gdb, not used in real code. Note that gdb
-- can't find Node_Offsets.Table without a full expanded name.
function Shift_Left (S : Slot; V : Natural) return Slot;
pragma Import (Intrinsic, Shift_Left);
function Shift_Right (S : Slot; V : Natural) return Slot;
pragma Import (Intrinsic, Shift_Right);
-- Low-level types for fields of the various supported sizes.
-- All fields are a power of 2 number of bits, and are aligned
-- to that number of bits:
type Field_Size_1_Bit is mod 2**1;
type Field_Size_2_Bit is mod 2**2;
type Field_Size_4_Bit is mod 2**4;
type Field_Size_8_Bit is mod 2**8;
type Field_Size_32_Bit is mod 2**32;
Slots_Low_Bound : constant Field_Offset := Field_Offset'First + 1;
package Slots is new Table.Table
(Table_Component_Type => Slot,
Table_Index_Type => Node_Offset'Base,
Table_Low_Bound => Slots_Low_Bound,
Table_Initial => Alloc.Slots_Initial,
Table_Increment => Alloc.Slots_Increment,
Table_Name => "Slots");
-- Note that Table_Low_Bound is set such that if we try to access
-- Slots.Table (0), we will get Constraint_Error.
Slts : Slots.Table_Ptr renames Slots.Table with
function Slast return Node_Offset'Base renames Slots.Last with
-- Short names for use in gdb, not used in real code. Note that gdb
-- can't find Slots.Table without a full expanded name.
function Alloc_Node_Id return Node_Id with Inline;
function Alloc_Slots (Num_Slots : Slot_Count) return Node_Offset
with Inline;
-- Allocate the slots for a node in the Slots table
-- Each of the following Get_N_Bit_Field functions fetches the field of
-- the given Field_Type at the given offset. Field_Type'Size must be N.
-- The offset is measured in units of Field_Type'Size. Likewise for the
-- Set_N_Bit_Field procedures. These are instantiated in Sinfo.Nodes and
-- Einfo.Entities for the various possible Field_Types (Flag, Node_Id,
-- Uint, etc).
type Field_Type is private;
function Get_1_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
with Inline;
type Field_Type is private;
function Get_2_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
with Inline;
type Field_Type is private;
function Get_4_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
with Inline;
type Field_Type is private;
function Get_8_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
with Inline;
type Field_Type is private;
function Get_32_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
with Inline;
type Field_Type is private;
Default_Val : Field_Type;
function Get_32_Bit_Field_With_Default
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
with Inline;
-- If the field has not yet been set, return Default_Val
type Field_Type is private;
function Get_Valid_32_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
with Inline;
-- Assert that the field has already been set. This is currently used
-- only for Uints, but could be used more generally.
type Field_Type is private;
procedure Set_1_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
with Inline;
type Field_Type is private;
procedure Set_2_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
with Inline;
type Field_Type is private;
procedure Set_4_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
with Inline;
type Field_Type is private;
procedure Set_8_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
with Inline;
type Field_Type is private;
procedure Set_32_Bit_Field
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
with Inline;
-- The following are similar to the above generics, but are not generic,
-- and work with the low-level Field_n_bit types. If generics could be
-- overloaded, we would use the same names.
function Get_1_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_1_Bit
with Inline;
function Get_2_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_2_Bit
with Inline;
function Get_4_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_4_Bit
with Inline;
function Get_8_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_8_Bit
with Inline;
function Get_32_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_32_Bit
with Inline;
procedure Set_1_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_1_Bit)
with Inline;
procedure Set_2_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_2_Bit)
with Inline;
procedure Set_4_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_4_Bit)
with Inline;
procedure Set_8_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_8_Bit)
with Inline;
procedure Set_32_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_32_Bit)
with Inline;
-- The following are used in "asserts on" mode to validate nodes; an
-- exception is raised if invalid node content is detected.
procedure Validate_Node (N : Node_Or_Entity_Id);
-- Validate for reading
procedure Validate_Node_Write (N : Node_Or_Entity_Id);
-- Validate for writing
function Is_Valid_Node (U : Union_Id) return Boolean;
-- True if U is within the range of Node_Offsets
procedure Print_Atree_Info (N : Node_Or_Entity_Id);
-- Called from Treepr to print out information about N that is private
-- to Atree.
end Atree_Private_Part;
-- Statistics:
subtype Call_Count is Nat_64;
Get_Count, Set_Count : array (Node_Or_Entity_Field) of Call_Count :=
(others => 0);
-- Number of calls to each getter and setter. See documentaton for
-- -gnatd.A.
Get_Original_Node_Count, Set_Original_Node_Count : Call_Count := 0;
procedure Print_Statistics;
end Atree;