| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- E X P _ D I S P -- |
| -- -- |
| -- GS p e c -- |
| -- -- |
| -- Copyright (C) 1992-2015, 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 -- |
| -- http://www.gnu.org/licenses 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 contains routines involved in tagged types and dynamic |
| -- dispatching expansion. |
| |
| with Types; use Types; |
| with Uintp; use Uintp; |
| |
| package Exp_Disp is |
| |
| ------------------------------------- |
| -- Predefined primitive operations -- |
| ------------------------------------- |
| |
| -- The predefined primitive operations (PPOs) are subprograms generated |
| -- by GNAT for a particular tagged type. Their role is to provide support |
| -- for different Ada language features such as the attribute 'Size or |
| -- handling of dispatching triggers in select statements. PPOs are created |
| -- when a tagged type is expanded or frozen. These subprograms are later |
| -- collected and inserted into the dispatch table of a tagged type at |
| -- fixed positions. Some of the PPOs that manipulate data in tagged objects |
| -- require the generation of thunks. |
| |
| -- List of predefined primitive operations |
| |
| -- Leading underscores designate reserved names. Bracketed numerical |
| -- values represent dispatch table slot numbers. |
| |
| -- _Size (1) - implementation of the attribute 'Size for any tagged |
| -- type. Constructs of the form Prefix'Size are converted into |
| -- Prefix._Size. |
| |
| -- TSS_Stream_Read (2) - implementation of the stream attribute Read |
| -- for any tagged type. |
| |
| -- TSS_Stream_Write (3) - implementation of the stream attribute Write |
| -- for any tagged type. |
| |
| -- TSS_Stream_Input (4) - implementation of the stream attribute Input |
| -- for any tagged type. |
| |
| -- TSS_Stream_Output (5) - implementation of the stream attribute |
| -- Output for any tagged type. |
| |
| -- Op_Eq (6) - implementation of the equality operator for any non- |
| -- limited tagged type. |
| |
| -- _Assign (7) - implementation of the assignment operator for any |
| -- non-limited tagged type. |
| |
| -- TSS_Deep_Adjust (8) - implementation of the finalization operation |
| -- Adjust for any non-limited tagged type. |
| |
| -- TSS_Deep_Finalize (9) - implementation of the finalization |
| -- operation Finalize for any non-limited tagged type. |
| |
| -- _Disp_Asynchronous_Select (10) - used in the expansion of ATC with |
| -- dispatching triggers. Null implementation for limited interfaces, |
| -- full body generation for types that implement limited interfaces, |
| -- not generated for the rest of the cases. See Expand_N_Asynchronous_ |
| -- Select in Exp_Ch9 for more information. |
| |
| -- _Disp_Conditional_Select (11) - used in the expansion of conditional |
| -- selects with dispatching triggers. Null implementation for limited |
| -- interfaces, full body generation for types that implement limited |
| -- interfaces, not generated for the rest of the cases. See Expand_N_ |
| -- Conditional_Entry_Call in Exp_Ch9 for more information. |
| |
| -- _Disp_Get_Prim_Op_Kind (12) - helper routine used in the expansion |
| -- of ATC with dispatching triggers. Null implementation for limited |
| -- interfaces, full body generation for types that implement limited |
| -- interfaces, not generated for the rest of the cases. |
| |
| -- _Disp_Get_Task_Id (13) - helper routine used in the expansion of |
| -- Abort, attributes 'Callable and 'Terminated for task interface |
| -- class-wide types. Full body generation for task types, null |
| -- implementation for limited interfaces, not generated for the rest |
| -- of the cases. See Expand_N_Attribute_Reference in Exp_Attr and |
| -- Expand_N_Abort_Statement in Exp_Ch9 for more information. |
| |
| -- _Disp_Requeue (14) - used in the expansion of dispatching requeue |
| -- statements. Null implementation is provided for protected, task |
| -- and synchronized interfaces. Protected and task types implementing |
| -- concurrent interfaces receive full bodies. See Expand_N_Requeue_ |
| -- Statement in Exp_Ch9 for more information. |
| |
| -- _Disp_Timed_Select (15) - used in the expansion of timed selects |
| -- with dispatching triggers. Null implementation for limited |
| -- interfaces, full body generation for types that implement limited |
| -- interfaces, not generated for the rest of the cases. See Expand_N_ |
| -- Timed_Entry_Call for more information. |
| |
| -- Life cycle of predefined primitive operations |
| |
| -- The specifications and bodies of the PPOs are created by |
| -- Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies |
| -- in Exp_Ch3. The generated specifications are immediately analyzed, |
| -- while the bodies are left as freeze actions to the tagged type for |
| -- which they are created. |
| |
| -- PPOs are collected and added to the Primitive_Operations list of |
| -- a type by the regular analysis mechanism. |
| |
| -- PPOs are frozen by Exp_Ch3.Predefined_Primitive_Freeze |
| |
| -- Thunks for PPOs are created by Make_DT |
| |
| -- Dispatch table positions of PPOs are set by Set_All_DT_Position |
| |
| -- Calls to PPOs proceed as regular dispatching calls. If the PPO |
| -- has a thunk, a call proceeds as a regular dispatching call with |
| -- a thunk. |
| |
| -- Guidelines for addition of new predefined primitive operations |
| |
| -- Update the value of constant Max_Predef_Prims in a-tags.ads to |
| -- indicate the new number of PPOs. |
| |
| -- Introduce a new predefined name for the new PPO in Snames.ads and |
| -- Snames.adb. |
| |
| -- Categorize the new PPO name as predefined by adding an entry in |
| -- Is_Predefined_Dispatching_Operation in Exp_Disp. |
| |
| -- Generate the specification of the new PPO in Make_Predefined_ |
| -- Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining |
| -- identifier of the specification must be set to True. |
| |
| -- Generate the body of the new PPO in Predefined_Primitive_Bodies in |
| -- Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the |
| -- specification must be set to True. |
| |
| -- If the new PPO requires a thunk, add an entry in Freeze_Subprogram |
| -- in Exp_Ch6.adb. |
| |
| -- When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads |
| -- to retrieve the entity of the operation directly. |
| |
| -- Number of predefined primitive operations added by the Expander |
| -- for a tagged type. If more predefined primitive operations are |
| -- added, the following items must be changed: |
| |
| -- Ada.Tags.Max_Predef_Prims - indirect use |
| -- Exp_Disp.Default_Prim_Op_Position - indirect use |
| -- Exp_Disp.Set_All_DT_Position - direct use |
| |
| procedure Apply_Tag_Checks (Call_Node : Node_Id); |
| -- Generate checks required on dispatching calls |
| |
| function Building_Static_DT (Typ : Entity_Id) return Boolean; |
| pragma Inline (Building_Static_DT); |
| -- Returns true when building statically allocated dispatch tables |
| |
| procedure Build_Static_Dispatch_Tables (N : Node_Id); |
| -- N is a library level package declaration or package body. Build the |
| -- static dispatch table of the tagged types defined at library level. In |
| -- case of package declarations with private part the generated nodes are |
| -- added at the end of the list of private declarations. Otherwise they are |
| -- added to the end of the list of public declarations. In case of package |
| -- bodies they are added to the end of the list of declarations of the |
| -- package body. |
| |
| function Convert_Tag_To_Interface |
| (Typ : Entity_Id; Expr : Node_Id) return Node_Id; |
| pragma Inline (Convert_Tag_To_Interface); |
| -- This function is used in class-wide interface conversions; the expanded |
| -- code generated to convert a tagged object to a class-wide interface type |
| -- involves referencing the tag component containing the secondary dispatch |
| -- table associated with the interface. Given the expression Expr that |
| -- references a tag component, we cannot generate an unchecked conversion |
| -- to leave the expression decorated with the class-wide interface type Typ |
| -- because an unchecked conversion cannot be seen as a no-op. An unchecked |
| -- conversion is conceptually a function call and therefore the RM allows |
| -- the backend to obtain a copy of the value of the actual object and store |
| -- it in some other place (like a register); in such case the interface |
| -- conversion is not equivalent to a displacement of the pointer to the |
| -- interface and any further displacement fails. Although the functionality |
| -- of this function is simple and could be done directly, the purpose of |
| -- this routine is to leave well documented in the sources these |
| -- occurrences. |
| |
| -- If Expr is an N_Selected_Component that references a tag generate: |
| -- type ityp is non null access Typ; |
| -- ityp!(Expr'Address).all |
| |
| -- if Expr is an N_Function_Call to Ada.Tags.Displace then generate: |
| -- type ityp is non null access Typ; |
| -- ityp!(Expr).all |
| |
| function CPP_Num_Prims (Typ : Entity_Id) return Nat; |
| -- Return the number of primitives of the C++ part of the dispatch table. |
| -- For types that are not derivations of CPP types return 0. |
| |
| procedure Expand_Dispatching_Call (Call_Node : Node_Id); |
| -- Expand the call to the operation through the dispatch table and perform |
| -- the required tag checks when appropriate. For CPP types tag checks are |
| -- not relevant. |
| |
| procedure Expand_Interface_Actuals (Call_Node : Node_Id); |
| -- Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide |
| -- interfaces to reference the interface tag of the actual object |
| |
| procedure Expand_Interface_Conversion (N : Node_Id); |
| -- Ada 2005 (AI-251): N is a type-conversion node. Displace the pointer |
| -- to the object to give access to the interface tag associated with the |
| -- dispatch table of the target type. |
| |
| procedure Expand_Interface_Thunk |
| (Prim : Node_Id; |
| Thunk_Id : out Entity_Id; |
| Thunk_Code : out Node_Id); |
| -- Ada 2005 (AI-251): When a tagged type implements abstract interfaces we |
| -- generate additional subprograms (thunks) associated with each primitive |
| -- Prim to have a layout compatible with the C++ ABI. The thunk displaces |
| -- the pointers to the actuals that depend on the controlling type before |
| -- transferring control to the target subprogram. If there is no need to |
| -- generate the thunk then Thunk_Id and Thunk_Code are set to Empty. |
| -- Otherwise they are set to the defining identifier and the subprogram |
| -- body of the generated thunk. |
| |
| function Has_CPP_Constructors (Typ : Entity_Id) return Boolean; |
| -- Returns true if the type has CPP constructors |
| |
| function Is_Expanded_Dispatching_Call (N : Node_Id) return Boolean; |
| -- Returns true if N is the expanded code of a dispatching call |
| |
| function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean; |
| -- Ada 2005 (AI-251): Determines if E is a predefined primitive operation |
| |
| function Is_Predefined_Internal_Operation (E : Entity_Id) return Boolean; |
| -- Similar to the previous one, but excludes stream operations, because |
| -- these may be overridden, and need extra formals, like user-defined |
| -- operations. |
| |
| function Is_Predefined_Interface_Primitive (E : Entity_Id) return Boolean; |
| -- Ada 2005 (AI-345): Returns True if E is one of the predefined primitives |
| -- required to implement interfaces. |
| |
| function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id; |
| -- Expand the declarations for the Dispatch Table. The node N is the |
| -- declaration that forces the generation of the table. It is used to place |
| -- error messages when the declaration leads to the freezing of a given |
| -- primitive operation that has an incomplete non- tagged formal. |
| |
| function Make_Disp_Asynchronous_Select_Body |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI-345): Generate the body of the primitive operation of type |
| -- Typ used for dispatching in asynchronous selects. Generate a null body |
| -- if Typ is an interface type. |
| |
| function Make_Disp_Asynchronous_Select_Spec |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI-345): Generate the specification of the primitive operation |
| -- of type Typ used for dispatching in asynchronous selects. |
| |
| function Make_Disp_Conditional_Select_Body |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI-345): Generate the body of the primitive operation of type |
| -- Typ used for dispatching in conditional selects. Generate a null body |
| -- if Typ is an interface type. |
| |
| function Make_Disp_Conditional_Select_Spec |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI-345): Generate the specification of the primitive operation |
| -- of type Typ used for dispatching in conditional selects. |
| |
| function Make_Disp_Get_Prim_Op_Kind_Body |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI-345): Generate the body of the primitive operation of type |
| -- Typ used for retrieving the callable entity kind during dispatching in |
| -- asynchronous selects. Generate a null body if Typ is an interface type. |
| |
| function Make_Disp_Get_Prim_Op_Kind_Spec |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI-345): Generate the specification of the primitive operation |
| -- of the type Typ use for retrieving the callable entity kind during |
| -- dispatching in asynchronous selects. |
| |
| function Make_Disp_Get_Task_Id_Body |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI-345): Generate body of the primitive operation of type Typ |
| -- used for retrieving the _task_id field of a task interface class- wide |
| -- type. Generate a null body if Typ is an interface or a non-task type. |
| |
| function Make_Disp_Get_Task_Id_Spec |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI-345): Generate the specification of the primitive operation |
| -- of type Typ used for retrieving the _task_id field of a task interface |
| -- class-wide type. |
| |
| function Make_Disp_Requeue_Body |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI05-0030): Generate the body of the primitive operation of |
| -- type Typ used for dispatching on requeue statements. Generate a body |
| -- containing a single null-statement if Typ is an interface type. |
| |
| function Make_Disp_Requeue_Spec |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI05-0030): Generate the specification of the primitive |
| -- operation of type Typ used for dispatching requeue statements. |
| |
| function Make_Disp_Timed_Select_Body |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI-345): Generate the body of the primitive operation of type |
| -- Typ used for dispatching in timed selects. Generate a body containing |
| -- a single null-statement if Typ is an interface type. |
| |
| function Make_Disp_Timed_Select_Spec |
| (Typ : Entity_Id) return Node_Id; |
| -- Ada 2005 (AI-345): Generate the specification of the primitive operation |
| -- of type Typ used for dispatching in timed selects. |
| |
| function Make_Select_Specific_Data_Table |
| (Typ : Entity_Id) return List_Id; |
| -- Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD |
| -- of Typ used for dispatching in asynchronous, conditional and timed |
| -- selects. Generate code to set the primitive operation kinds and entry |
| -- indexes of primitive operations and primitive wrappers. |
| |
| function Make_Tags (Typ : Entity_Id) return List_Id; |
| -- Generate the entities associated with the primary and secondary tags of |
| -- Typ and fill the contents of Access_Disp_Table. In case of library level |
| -- tagged types this routine imports the forward declaration of the tag |
| -- entity, that will be declared and exported by Make_DT. |
| |
| function Make_VM_TSD (Typ : Entity_Id) return List_Id; |
| -- Build the Type Specific Data record associated with tagged type Typ. |
| -- Invoked only when generating code for VM targets. |
| |
| function Register_Primitive |
| (Loc : Source_Ptr; |
| Prim : Entity_Id) return List_Id; |
| -- Build code to register Prim in the primary or secondary dispatch table. |
| -- If Prim is associated with a secondary dispatch table then generate also |
| -- its thunk and register it in the associated secondary dispatch table. |
| -- In general the dispatch tables are always generated by Make_DT and |
| -- Make_Secondary_DT; this routine is only used in two corner cases: |
| -- |
| -- 1) To construct the dispatch table of a tagged type whose parent |
| -- is a CPP_Class (see Build_Init_Procedure). |
| -- 2) To handle late overriding of dispatching operations (see |
| -- Check_Dispatching_Operation and Make_DT). |
| -- |
| -- The caller is responsible for inserting the generated code in the |
| -- proper place. |
| |
| procedure Set_All_DT_Position (Typ : Entity_Id); |
| -- Set the DT_Position field for each primitive operation. In the CPP |
| -- Class case check that no pragma CPP_Virtual is missing and that the |
| -- DT_Position are coherent |
| |
| procedure Set_CPP_Constructors (Typ : Entity_Id); |
| -- Typ is a CPP_Class type. Create the Init procedures of that type |
| -- required to handle its default and non-default constructors. The |
| -- functions to which pragma CPP_Constructor is applied in the sources |
| -- are functions returning this type, and having an implicit access to the |
| -- target object in its first argument; such implicit argument is explicit |
| -- in the IP procedures built here. |
| |
| procedure Set_DT_Position_Value (Prim : Entity_Id; Value : Uint); |
| -- Set the position of a dispatching primitive its dispatch table. For |
| -- subprogram wrappers propagate the value to the wrapped subprogram. |
| |
| procedure Set_DTC_Entity_Value (Tagged_Type : Entity_Id; Prim : Entity_Id); |
| -- Set the definite value of the DTC_Entity value associated with a given |
| -- primitive of a tagged type. For subprogram wrappers, propagate the value |
| -- to the wrapped subprogram. |
| |
| procedure Write_DT (Typ : Entity_Id); |
| pragma Export (Ada, Write_DT); |
| -- Debugging procedure (to be called within gdb) |
| |
| end Exp_Disp; |