1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- E X P _ A T A G -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2006-2020, 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 contains routines involved in the frontend expansion of 27-- subprograms of package Ada.Tags 28 29with Types; use Types; 30with Uintp; use Uintp; 31 32package Exp_Atag is 33 34 -- Note: In all the subprograms of this package formal 'Loc' is the source 35 -- location used in constructing the corresponding nodes. 36 37 procedure Build_Common_Dispatching_Select_Statements 38 (Typ : Entity_Id; 39 Stmts : List_Id); 40 -- Ada 2005 (AI-345): Build statements that are common to the expansion of 41 -- timed, asynchronous, and conditional select and append them to Stmts. 42 -- Typ is the tagged type used for dispatching calls. 43 44 function Build_Get_Access_Level 45 (Loc : Source_Ptr; 46 Tag_Node : Node_Id) return Node_Id; 47 -- Build code that retrieves the accessibility level of the tagged type. 48 -- 49 -- Generates: TSD (Tag).Access_Level 50 51 function Build_Get_Alignment 52 (Loc : Source_Ptr; 53 Tag_Node : Node_Id) return Node_Id; 54 -- Build code that retrieves the alignment of the tagged type. 55 -- Generates: TSD (Tag).Alignment 56 57 procedure Build_Get_Predefined_Prim_Op_Address 58 (Loc : Source_Ptr; 59 Position : Uint; 60 Tag_Node : in out Node_Id; 61 New_Node : out Node_Id); 62 -- Given a pointer to a dispatch table (T) and a position in the DT, build 63 -- code that gets the address of the predefined virtual function stored in 64 -- it (used for dispatching calls). Tag_Node is relocated. 65 -- 66 -- Generates: Predefined_DT (Tag).D (Position); 67 68 procedure Build_Get_Prim_Op_Address 69 (Loc : Source_Ptr; 70 Typ : Entity_Id; 71 Position : Uint; 72 Tag_Node : in out Node_Id; 73 New_Node : out Node_Id); 74 -- Build code that retrieves the address of the virtual function stored in 75 -- a given position of the dispatch table (used for dispatching calls). 76 -- Tag_Node is relocated. 77 -- 78 -- Generates: To_Tag (Tag).D (Position); 79 80 function Build_Get_Transportable 81 (Loc : Source_Ptr; 82 Tag_Node : Node_Id) return Node_Id; 83 -- Build code that retrieves the value of the Transportable flag for 84 -- the given Tag. 85 -- 86 -- Generates: TSD (Tag).Transportable; 87 88 function Build_Inherit_CPP_Prims (Typ : Entity_Id) return List_Id; 89 -- Build code that copies from Typ's parent the dispatch table slots of 90 -- inherited primitives and updates slots of overridden primitives. The 91 -- generated code handles primary and secondary dispatch tables of Typ. 92 93 function Build_Inherit_Predefined_Prims 94 (Loc : Source_Ptr; 95 Old_Tag_Node : Node_Id; 96 New_Tag_Node : Node_Id; 97 Num_Predef_Prims : Nat) return Node_Id; 98 -- Build code that inherits the predefined primitives of the parent. 99 -- 100 -- Generates: Predefined_DT (New_T).D (All_Predefined_Prims) := 101 -- Predefined_DT (Old_T).D (All_Predefined_Prims); 102 -- 103 -- Required to build non-library level dispatch tables. Also required 104 -- when compiling without static dispatch tables support. 105 106 function Build_Inherit_Prims 107 (Loc : Source_Ptr; 108 Typ : Entity_Id; 109 Old_Tag_Node : Node_Id; 110 New_Tag_Node : Node_Id; 111 Num_Prims : Nat) return Node_Id; 112 -- Build code that inherits Num_Prims user-defined primitives from the 113 -- dispatch table of the parent type of tagged type Typ. It is used to 114 -- copy the dispatch table of the parent in the following cases: 115 -- a) case of derivations of CPP_Class types 116 -- b) tagged types whose dispatch table is not statically allocated 117 -- 118 -- Generates: 119 -- New_Tag.Prims_Ptr (1 .. Num_Prims) := 120 -- Old_Tag.Prims_Ptr (1 .. Num_Prims); 121 122 function Build_Offset_To_Top 123 (Loc : Source_Ptr; 124 This_Node : Node_Id) return Node_Id; 125 -- Build code that references the Offset_To_Top component of the primary 126 -- or secondary dispatch table associated with This_Node. This subprogram 127 -- provides a subset of the functionality provided by the function 128 -- Offset_To_Top of package Ada.Tags, and is only called by the frontend 129 -- when such routine is not available in a configurable runtime. 130 -- 131 -- Generates: 132 -- Offset_To_Top_Ptr 133 -- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all 134 135 function Build_Set_Predefined_Prim_Op_Address 136 (Loc : Source_Ptr; 137 Tag_Node : Node_Id; 138 Position : Uint; 139 Address_Node : Node_Id) return Node_Id; 140 -- Build code that saves the address of a virtual function in a given 141 -- Position of the portion of the dispatch table associated with the 142 -- predefined primitives of Tag. Called from Exp_Disp.Fill_DT_Entry 143 -- and Exp_Disp.Fill_Secondary_DT_Entry. It is used for: 144 -- 1) Filling the dispatch table of CPP_Class types. 145 -- 2) Late overriding (see Check_Dispatching_Operation). 146 -- 147 -- Generates: Predefined_DT (Tag).D (Position) := Value 148 149 function Build_Set_Prim_Op_Address 150 (Loc : Source_Ptr; 151 Typ : Entity_Id; 152 Tag_Node : Node_Id; 153 Position : Uint; 154 Address_Node : Node_Id) return Node_Id; 155 -- Build code that saves the address of a virtual function in a given 156 -- Position of the dispatch table associated with the Tag. Called from 157 -- Exp_Disp.Fill_DT_Entry and Exp_Disp.Fill_Secondary_DT_Entry. Used for: 158 -- 1) Filling the dispatch table of CPP_Class types. 159 -- 2) Late overriding (see Check_Dispatching_Operation). 160 -- 161 -- Generates: Tag.D (Position) := Value 162 163 function Build_Set_Size_Function 164 (Loc : Source_Ptr; 165 Tag_Node : Node_Id; 166 Size_Func : Entity_Id) return Node_Id; 167 -- Build code that saves in the TSD the address of the function 168 -- calculating _size of the object. 169 170 function Build_Set_Static_Offset_To_Top 171 (Loc : Source_Ptr; 172 Iface_Tag : Node_Id; 173 Offset_Value : Node_Id) return Node_Id; 174 -- Build code that initialize the Offset_To_Top component of the 175 -- secondary dispatch table referenced by Iface_Tag. 176 -- 177 -- Generates: 178 -- Offset_To_Top_Ptr 179 -- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all 180 -- := Offset_Value 181 182end Exp_Atag; 183