1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- E X P _ C H 3 -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 1992-2019, 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-- Expand routines for chapter 3 constructs 27 28with Types; use Types; 29with Elists; use Elists; 30with Uintp; use Uintp; 31 32package Exp_Ch3 is 33 34 procedure Expand_N_Object_Declaration (N : Node_Id); 35 procedure Expand_N_Subtype_Indication (N : Node_Id); 36 procedure Expand_N_Variant_Part (N : Node_Id); 37 procedure Expand_N_Full_Type_Declaration (N : Node_Id); 38 39 procedure Expand_Previous_Access_Type (Def_Id : Entity_Id); 40 -- For a full type declaration that contains tasks, or that is a task, 41 -- check whether there exists an access type whose designated type is an 42 -- incomplete declarations for the current composite type. If so, build the 43 -- master for that access type, now that it is known to denote an object 44 -- with tasks. 45 46 procedure Expand_Record_Extension (T : Entity_Id; Def : Node_Id); 47 -- Add a field _parent in the extension part of the record 48 49 procedure Build_Discr_Checking_Funcs (N : Node_Id); 50 -- Builds function which checks whether the component name is consistent 51 -- with the current discriminants. N is the full type declaration node, 52 -- and the discriminant checking functions are inserted after this node. 53 54 function Build_Initialization_Call 55 (Loc : Source_Ptr; 56 Id_Ref : Node_Id; 57 Typ : Entity_Id; 58 In_Init_Proc : Boolean := False; 59 Enclos_Type : Entity_Id := Empty; 60 Discr_Map : Elist_Id := New_Elmt_List; 61 With_Default_Init : Boolean := False; 62 Constructor_Ref : Node_Id := Empty) return List_Id; 63 -- Builds a call to the initialization procedure for the base type of Typ, 64 -- passing it the object denoted by Id_Ref, plus additional parameters as 65 -- appropriate for the type (the _Master, for task types, for example). 66 -- Loc is the source location for the constructed tree. In_Init_Proc has 67 -- to be set to True when the call is itself in an init proc in order to 68 -- enable the use of discriminals. Enclos_Type is the enclosing type when 69 -- initializing a component in an outer init proc, and it is used for 70 -- various expansion cases including the case where Typ is a task type 71 -- which is an array component, the indexes of the enclosing type are 72 -- used to build the string that identifies each task at runtime. 73 -- 74 -- Discr_Map is used to replace discriminants by their discriminals in 75 -- expressions used to constrain record components. In the presence of 76 -- entry families bounded by discriminants, protected type discriminants 77 -- can appear within expressions in array bounds (not as stand-alone 78 -- identifiers) and a general replacement is necessary. 79 -- 80 -- Ada 2005 (AI-287): With_Default_Init is used to indicate that the 81 -- initialization call corresponds to a default initialized component 82 -- of an aggregate. 83 -- 84 -- Constructor_Ref is a call to a constructor subprogram. It is currently 85 -- used only to support C++ constructors. 86 87 function Build_Variant_Record_Equality 88 (Typ : Entity_Id; 89 Body_Id : Entity_Id; 90 Param_Specs : List_Id) return Node_Id; 91 -- Build the body of the equality function Body_Id for the untagged variant 92 -- record Typ with the given parameters specification list. 93 94 function Freeze_Type (N : Node_Id) return Boolean; 95 -- This function executes the freezing actions associated with the given 96 -- freeze type node N and returns True if the node is to be deleted. We 97 -- delete the node if it is present just for front end purpose and we don't 98 -- want Gigi to see the node. This function can't delete the node itself 99 -- since it would confuse any remaining processing of the freeze node. 100 101 function Get_Simple_Init_Val 102 (Typ : Entity_Id; 103 N : Node_Id; 104 Size : Uint := No_Uint) return Node_Id; 105 -- Build an expression that represents the required initial value of type 106 -- Typ for which predicate Needs_Simple_Initialization is True. N is a node 107 -- whose source location is used in the construction of the expression. 108 -- Size is used as follows: 109 -- 110 -- * If the size of the object to be initialized it is known, it should 111 -- be passed to the routine. 112 -- 113 -- * If the size is unknown or is zero, then the Esize of Typ is used as 114 -- an estimate of the size. 115 -- 116 -- The object size is needed to prepare a known invalid value for use by 117 -- Normalize_Scalars. A call to this routine where Typ denotes a scalar 118 -- type is valid only when Normalize_Scalars or Initialize_Scalars is 119 -- active, or if N is the node for a 'Invalid_Value attribute node. 120 121 procedure Init_Secondary_Tags 122 (Typ : Entity_Id; 123 Target : Node_Id; 124 Init_Tags_List : List_Id; 125 Stmts_List : List_Id; 126 Fixed_Comps : Boolean := True; 127 Variable_Comps : Boolean := True); 128 -- Ada 2005 (AI-251): Initialize the tags of the secondary dispatch tables 129 -- of Typ. The generated code referencing tag fields of Target is appended 130 -- to Init_Tags_List and the code required to complete the elaboration of 131 -- the dispatch tables of Typ is appended to Stmts_List. If Fixed_Comps is 132 -- True then the tag components located at fixed positions of Target are 133 -- initialized; if Variable_Comps is True then tags components located at 134 -- variable positions of Target are initialized. 135 136 function Make_Tag_Assignment (N : Node_Id) return Node_Id; 137 -- An object declaration that has an initialization for a tagged object 138 -- requires a separate reassignment of the tag of the given type, because 139 -- the expression may include an unchecked conversion. This tag assignment 140 -- is inserted after the declaration, but if the object has an address 141 -- clause the assignment is handled as part of the freezing of the object, 142 -- see Check_Address_Clause. 143 144end Exp_Ch3; 145