1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- E X P _ D I S P -- 6-- -- 7-- GS p e c -- 8-- -- 9-- Copyright (C) 1992-2015, 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 tagged types and dynamic 27-- dispatching expansion. 28 29with Types; use Types; 30with Uintp; use Uintp; 31 32package Exp_Disp is 33 34 ------------------------------------- 35 -- Predefined primitive operations -- 36 ------------------------------------- 37 38 -- The predefined primitive operations (PPOs) are subprograms generated 39 -- by GNAT for a particular tagged type. Their role is to provide support 40 -- for different Ada language features such as the attribute 'Size or 41 -- handling of dispatching triggers in select statements. PPOs are created 42 -- when a tagged type is expanded or frozen. These subprograms are later 43 -- collected and inserted into the dispatch table of a tagged type at 44 -- fixed positions. Some of the PPOs that manipulate data in tagged objects 45 -- require the generation of thunks. 46 47 -- List of predefined primitive operations 48 49 -- Leading underscores designate reserved names. Bracketed numerical 50 -- values represent dispatch table slot numbers. 51 52 -- _Size (1) - implementation of the attribute 'Size for any tagged 53 -- type. Constructs of the form Prefix'Size are converted into 54 -- Prefix._Size. 55 56 -- TSS_Stream_Read (2) - implementation of the stream attribute Read 57 -- for any tagged type. 58 59 -- TSS_Stream_Write (3) - implementation of the stream attribute Write 60 -- for any tagged type. 61 62 -- TSS_Stream_Input (4) - implementation of the stream attribute Input 63 -- for any tagged type. 64 65 -- TSS_Stream_Output (5) - implementation of the stream attribute 66 -- Output for any tagged type. 67 68 -- Op_Eq (6) - implementation of the equality operator for any non- 69 -- limited tagged type. 70 71 -- _Assign (7) - implementation of the assignment operator for any 72 -- non-limited tagged type. 73 74 -- TSS_Deep_Adjust (8) - implementation of the finalization operation 75 -- Adjust for any non-limited tagged type. 76 77 -- TSS_Deep_Finalize (9) - implementation of the finalization 78 -- operation Finalize for any non-limited tagged type. 79 80 -- _Disp_Asynchronous_Select (10) - used in the expansion of ATC with 81 -- dispatching triggers. Null implementation for limited interfaces, 82 -- full body generation for types that implement limited interfaces, 83 -- not generated for the rest of the cases. See Expand_N_Asynchronous_ 84 -- Select in Exp_Ch9 for more information. 85 86 -- _Disp_Conditional_Select (11) - used in the expansion of conditional 87 -- selects with dispatching triggers. Null implementation for limited 88 -- interfaces, full body generation for types that implement limited 89 -- interfaces, not generated for the rest of the cases. See Expand_N_ 90 -- Conditional_Entry_Call in Exp_Ch9 for more information. 91 92 -- _Disp_Get_Prim_Op_Kind (12) - helper routine used in the expansion 93 -- of ATC with dispatching triggers. Null implementation for limited 94 -- interfaces, full body generation for types that implement limited 95 -- interfaces, not generated for the rest of the cases. 96 97 -- _Disp_Get_Task_Id (13) - helper routine used in the expansion of 98 -- Abort, attributes 'Callable and 'Terminated for task interface 99 -- class-wide types. Full body generation for task types, null 100 -- implementation for limited interfaces, not generated for the rest 101 -- of the cases. See Expand_N_Attribute_Reference in Exp_Attr and 102 -- Expand_N_Abort_Statement in Exp_Ch9 for more information. 103 104 -- _Disp_Requeue (14) - used in the expansion of dispatching requeue 105 -- statements. Null implementation is provided for protected, task 106 -- and synchronized interfaces. Protected and task types implementing 107 -- concurrent interfaces receive full bodies. See Expand_N_Requeue_ 108 -- Statement in Exp_Ch9 for more information. 109 110 -- _Disp_Timed_Select (15) - used in the expansion of timed selects 111 -- with dispatching triggers. Null implementation for limited 112 -- interfaces, full body generation for types that implement limited 113 -- interfaces, not generated for the rest of the cases. See Expand_N_ 114 -- Timed_Entry_Call for more information. 115 116 -- Life cycle of predefined primitive operations 117 118 -- The specifications and bodies of the PPOs are created by 119 -- Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies 120 -- in Exp_Ch3. The generated specifications are immediately analyzed, 121 -- while the bodies are left as freeze actions to the tagged type for 122 -- which they are created. 123 124 -- PPOs are collected and added to the Primitive_Operations list of 125 -- a type by the regular analysis mechanism. 126 127 -- PPOs are frozen by Exp_Ch3.Predefined_Primitive_Freeze 128 129 -- Thunks for PPOs are created by Make_DT 130 131 -- Dispatch table positions of PPOs are set by Set_All_DT_Position 132 133 -- Calls to PPOs proceed as regular dispatching calls. If the PPO 134 -- has a thunk, a call proceeds as a regular dispatching call with 135 -- a thunk. 136 137 -- Guidelines for addition of new predefined primitive operations 138 139 -- Update the value of constant Max_Predef_Prims in a-tags.ads to 140 -- indicate the new number of PPOs. 141 142 -- Introduce a new predefined name for the new PPO in Snames.ads and 143 -- Snames.adb. 144 145 -- Categorize the new PPO name as predefined by adding an entry in 146 -- Is_Predefined_Dispatching_Operation in Exp_Disp. 147 148 -- Generate the specification of the new PPO in Make_Predefined_ 149 -- Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining 150 -- identifier of the specification must be set to True. 151 152 -- Generate the body of the new PPO in Predefined_Primitive_Bodies in 153 -- Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the 154 -- specification must be set to True. 155 156 -- If the new PPO requires a thunk, add an entry in Freeze_Subprogram 157 -- in Exp_Ch6.adb. 158 159 -- When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads 160 -- to retrieve the entity of the operation directly. 161 162 -- Number of predefined primitive operations added by the Expander 163 -- for a tagged type. If more predefined primitive operations are 164 -- added, the following items must be changed: 165 166 -- Ada.Tags.Max_Predef_Prims - indirect use 167 -- Exp_Disp.Default_Prim_Op_Position - indirect use 168 -- Exp_Disp.Set_All_DT_Position - direct use 169 170 procedure Apply_Tag_Checks (Call_Node : Node_Id); 171 -- Generate checks required on dispatching calls 172 173 function Building_Static_DT (Typ : Entity_Id) return Boolean; 174 pragma Inline (Building_Static_DT); 175 -- Returns true when building statically allocated dispatch tables 176 177 procedure Build_Static_Dispatch_Tables (N : Node_Id); 178 -- N is a library level package declaration or package body. Build the 179 -- static dispatch table of the tagged types defined at library level. In 180 -- case of package declarations with private part the generated nodes are 181 -- added at the end of the list of private declarations. Otherwise they are 182 -- added to the end of the list of public declarations. In case of package 183 -- bodies they are added to the end of the list of declarations of the 184 -- package body. 185 186 function Convert_Tag_To_Interface 187 (Typ : Entity_Id; Expr : Node_Id) return Node_Id; 188 pragma Inline (Convert_Tag_To_Interface); 189 -- This function is used in class-wide interface conversions; the expanded 190 -- code generated to convert a tagged object to a class-wide interface type 191 -- involves referencing the tag component containing the secondary dispatch 192 -- table associated with the interface. Given the expression Expr that 193 -- references a tag component, we cannot generate an unchecked conversion 194 -- to leave the expression decorated with the class-wide interface type Typ 195 -- because an unchecked conversion cannot be seen as a no-op. An unchecked 196 -- conversion is conceptually a function call and therefore the RM allows 197 -- the backend to obtain a copy of the value of the actual object and store 198 -- it in some other place (like a register); in such case the interface 199 -- conversion is not equivalent to a displacement of the pointer to the 200 -- interface and any further displacement fails. Although the functionality 201 -- of this function is simple and could be done directly, the purpose of 202 -- this routine is to leave well documented in the sources these 203 -- occurrences. 204 205 -- If Expr is an N_Selected_Component that references a tag generate: 206 -- type ityp is non null access Typ; 207 -- ityp!(Expr'Address).all 208 209 -- if Expr is an N_Function_Call to Ada.Tags.Displace then generate: 210 -- type ityp is non null access Typ; 211 -- ityp!(Expr).all 212 213 function CPP_Num_Prims (Typ : Entity_Id) return Nat; 214 -- Return the number of primitives of the C++ part of the dispatch table. 215 -- For types that are not derivations of CPP types return 0. 216 217 procedure Expand_Dispatching_Call (Call_Node : Node_Id); 218 -- Expand the call to the operation through the dispatch table and perform 219 -- the required tag checks when appropriate. For CPP types tag checks are 220 -- not relevant. 221 222 procedure Expand_Interface_Actuals (Call_Node : Node_Id); 223 -- Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide 224 -- interfaces to reference the interface tag of the actual object 225 226 procedure Expand_Interface_Conversion (N : Node_Id); 227 -- Ada 2005 (AI-251): N is a type-conversion node. Displace the pointer 228 -- to the object to give access to the interface tag associated with the 229 -- dispatch table of the target type. 230 231 procedure Expand_Interface_Thunk 232 (Prim : Node_Id; 233 Thunk_Id : out Entity_Id; 234 Thunk_Code : out Node_Id); 235 -- Ada 2005 (AI-251): When a tagged type implements abstract interfaces we 236 -- generate additional subprograms (thunks) associated with each primitive 237 -- Prim to have a layout compatible with the C++ ABI. The thunk displaces 238 -- the pointers to the actuals that depend on the controlling type before 239 -- transferring control to the target subprogram. If there is no need to 240 -- generate the thunk then Thunk_Id and Thunk_Code are set to Empty. 241 -- Otherwise they are set to the defining identifier and the subprogram 242 -- body of the generated thunk. 243 244 function Has_CPP_Constructors (Typ : Entity_Id) return Boolean; 245 -- Returns true if the type has CPP constructors 246 247 function Is_Expanded_Dispatching_Call (N : Node_Id) return Boolean; 248 -- Returns true if N is the expanded code of a dispatching call 249 250 function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean; 251 -- Ada 2005 (AI-251): Determines if E is a predefined primitive operation 252 253 function Is_Predefined_Internal_Operation (E : Entity_Id) return Boolean; 254 -- Similar to the previous one, but excludes stream operations, because 255 -- these may be overridden, and need extra formals, like user-defined 256 -- operations. 257 258 function Is_Predefined_Interface_Primitive (E : Entity_Id) return Boolean; 259 -- Ada 2005 (AI-345): Returns True if E is one of the predefined primitives 260 -- required to implement interfaces. 261 262 function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id; 263 -- Expand the declarations for the Dispatch Table. The node N is the 264 -- declaration that forces the generation of the table. It is used to place 265 -- error messages when the declaration leads to the freezing of a given 266 -- primitive operation that has an incomplete non- tagged formal. 267 268 function Make_Disp_Asynchronous_Select_Body 269 (Typ : Entity_Id) return Node_Id; 270 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type 271 -- Typ used for dispatching in asynchronous selects. Generate a null body 272 -- if Typ is an interface type. 273 274 function Make_Disp_Asynchronous_Select_Spec 275 (Typ : Entity_Id) return Node_Id; 276 -- Ada 2005 (AI-345): Generate the specification of the primitive operation 277 -- of type Typ used for dispatching in asynchronous selects. 278 279 function Make_Disp_Conditional_Select_Body 280 (Typ : Entity_Id) return Node_Id; 281 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type 282 -- Typ used for dispatching in conditional selects. Generate a null body 283 -- if Typ is an interface type. 284 285 function Make_Disp_Conditional_Select_Spec 286 (Typ : Entity_Id) return Node_Id; 287 -- Ada 2005 (AI-345): Generate the specification of the primitive operation 288 -- of type Typ used for dispatching in conditional selects. 289 290 function Make_Disp_Get_Prim_Op_Kind_Body 291 (Typ : Entity_Id) return Node_Id; 292 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type 293 -- Typ used for retrieving the callable entity kind during dispatching in 294 -- asynchronous selects. Generate a null body if Typ is an interface type. 295 296 function Make_Disp_Get_Prim_Op_Kind_Spec 297 (Typ : Entity_Id) return Node_Id; 298 -- Ada 2005 (AI-345): Generate the specification of the primitive operation 299 -- of the type Typ use for retrieving the callable entity kind during 300 -- dispatching in asynchronous selects. 301 302 function Make_Disp_Get_Task_Id_Body 303 (Typ : Entity_Id) return Node_Id; 304 -- Ada 2005 (AI-345): Generate body of the primitive operation of type Typ 305 -- used for retrieving the _task_id field of a task interface class- wide 306 -- type. Generate a null body if Typ is an interface or a non-task type. 307 308 function Make_Disp_Get_Task_Id_Spec 309 (Typ : Entity_Id) return Node_Id; 310 -- Ada 2005 (AI-345): Generate the specification of the primitive operation 311 -- of type Typ used for retrieving the _task_id field of a task interface 312 -- class-wide type. 313 314 function Make_Disp_Requeue_Body 315 (Typ : Entity_Id) return Node_Id; 316 -- Ada 2005 (AI05-0030): Generate the body of the primitive operation of 317 -- type Typ used for dispatching on requeue statements. Generate a body 318 -- containing a single null-statement if Typ is an interface type. 319 320 function Make_Disp_Requeue_Spec 321 (Typ : Entity_Id) return Node_Id; 322 -- Ada 2005 (AI05-0030): Generate the specification of the primitive 323 -- operation of type Typ used for dispatching requeue statements. 324 325 function Make_Disp_Timed_Select_Body 326 (Typ : Entity_Id) return Node_Id; 327 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type 328 -- Typ used for dispatching in timed selects. Generate a body containing 329 -- a single null-statement if Typ is an interface type. 330 331 function Make_Disp_Timed_Select_Spec 332 (Typ : Entity_Id) return Node_Id; 333 -- Ada 2005 (AI-345): Generate the specification of the primitive operation 334 -- of type Typ used for dispatching in timed selects. 335 336 function Make_Select_Specific_Data_Table 337 (Typ : Entity_Id) return List_Id; 338 -- Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD 339 -- of Typ used for dispatching in asynchronous, conditional and timed 340 -- selects. Generate code to set the primitive operation kinds and entry 341 -- indexes of primitive operations and primitive wrappers. 342 343 function Make_Tags (Typ : Entity_Id) return List_Id; 344 -- Generate the entities associated with the primary and secondary tags of 345 -- Typ and fill the contents of Access_Disp_Table. In case of library level 346 -- tagged types this routine imports the forward declaration of the tag 347 -- entity, that will be declared and exported by Make_DT. 348 349 function Register_Primitive 350 (Loc : Source_Ptr; 351 Prim : Entity_Id) return List_Id; 352 -- Build code to register Prim in the primary or secondary dispatch table. 353 -- If Prim is associated with a secondary dispatch table then generate also 354 -- its thunk and register it in the associated secondary dispatch table. 355 -- In general the dispatch tables are always generated by Make_DT and 356 -- Make_Secondary_DT; this routine is only used in two corner cases: 357 -- 358 -- 1) To construct the dispatch table of a tagged type whose parent 359 -- is a CPP_Class (see Build_Init_Procedure). 360 -- 2) To handle late overriding of dispatching operations (see 361 -- Check_Dispatching_Operation and Make_DT). 362 -- 363 -- The caller is responsible for inserting the generated code in the 364 -- proper place. 365 366 procedure Set_All_DT_Position (Typ : Entity_Id); 367 -- Set the DT_Position field for each primitive operation. In the CPP 368 -- Class case check that no pragma CPP_Virtual is missing and that the 369 -- DT_Position are coherent 370 371 procedure Set_CPP_Constructors (Typ : Entity_Id); 372 -- Typ is a CPP_Class type. Create the Init procedures of that type 373 -- required to handle its default and non-default constructors. The 374 -- functions to which pragma CPP_Constructor is applied in the sources 375 -- are functions returning this type, and having an implicit access to the 376 -- target object in its first argument; such implicit argument is explicit 377 -- in the IP procedures built here. 378 379 procedure Set_DT_Position_Value (Prim : Entity_Id; Value : Uint); 380 -- Set the position of a dispatching primitive its dispatch table. For 381 -- subprogram wrappers propagate the value to the wrapped subprogram. 382 383 procedure Set_DTC_Entity_Value (Tagged_Type : Entity_Id; Prim : Entity_Id); 384 -- Set the definite value of the DTC_Entity value associated with a given 385 -- primitive of a tagged type. For subprogram wrappers, propagate the value 386 -- to the wrapped subprogram. 387 388 procedure Write_DT (Typ : Entity_Id); 389 pragma Export (Ada, Write_DT); 390 -- Debugging procedure (to be called within gdb) 391 392end Exp_Disp; 393