diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/exp_disp.ads')
| -rw-r--r-- | gcc-4.2.1/gcc/ada/exp_disp.ads | 362 |
1 files changed, 362 insertions, 0 deletions
diff --git a/gcc-4.2.1/gcc/ada/exp_disp.ads b/gcc-4.2.1/gcc/ada/exp_disp.ads new file mode 100644 index 000000000..50f1a6b2f --- /dev/null +++ b/gcc-4.2.1/gcc/ada/exp_disp.ads @@ -0,0 +1,362 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- E X P _ D I S P -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2005, 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 2, 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 COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- 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; + +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. + + -- _Alignment (2) - implementation of the attribute 'Alignment for + -- any tagged type. Constructs of the form Prefix'Alignment are + -- converted into Prefix._Alignment. + + -- TSS_Stream_Read (3) - implementation of the stream attribute Read + -- for any tagged type. + + -- TSS_Stream_Write (4) - implementation of the stream attribute Write + -- for any tagged type. + + -- TSS_Stream_Input (5) - implementation of the stream attribute Input + -- for any tagged type. + + -- TSS_Stream_Output (6) - implementation of the stream attribute + -- Output for any tagged type. + + -- Op_Eq (7) - implementation of the equality operator for any non- + -- limited tagged type. + + -- _Assign (8) - implementation of the assignment operator for any + -- non-limited tagged type. + + -- TSS_Deep_Adjust (9) - implementation of the finalization operation + -- Adjust for any non-limited tagged type. + + -- TSS_Deep_Finalize (10) - implementation of the finalization + -- operation Finalize for any non-limited tagged type. + + -- _Disp_Asynchronous_Select (11) - 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 (12) - 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 (13) - 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 (14) - 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_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. + + -- Lifecycle 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 in Predefined_Primitive_Freeze in Exp_Ch3. + + -- Thunks for PPOs are created in Freeze_Subprogram in Exp_Ch6, by a + -- call to Register_Predefined_DT_Entry, also in Exp_Ch6. + + -- Dispatch table positions of PPOs are set in Set_All_DT_Position in + -- Exp_Disp. + + -- Calls to PPOs procede as regular dispatching calls. If the PPO + -- has a thunk, a call procedes as a regular dispatching call with + -- a thunk. + + -- Guidelines for addition of new predefined primitive operations + + -- Update the value of constant Default_Prim_Op_Count in A-Tags.ads + -- to reflect 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_Util.adb. + + -- 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.Defailt_Prim_Op_Count - indirect use + -- Exp_Disp.Default_Prim_Op_Position - indirect use + -- Exp_Disp.Set_All_DT_Position - direct use + + type DT_Access_Action is + (CW_Membership, + IW_Membership, + DT_Entry_Size, + DT_Prologue_Size, + Get_Access_Level, + Get_Entry_Index, + Get_External_Tag, + Get_Predefined_Prim_Op_Address, + Get_Prim_Op_Address, + Get_Prim_Op_Kind, + Get_RC_Offset, + Get_Remotely_Callable, + Get_Tagged_Kind, + Inherit_DT, + Inherit_TSD, + Register_Interface_Tag, + Register_Tag, + Set_Access_Level, + Set_Entry_Index, + Set_Expanded_Name, + Set_External_Tag, + Set_Interface_Table, + Set_Offset_Index, + Set_OSD, + Set_Predefined_Prim_Op_Address, + Set_Prim_Op_Address, + Set_Prim_Op_Kind, + Set_RC_Offset, + Set_Remotely_Callable, + Set_Signature, + Set_SSD, + Set_TSD, + Set_Tagged_Kind, + TSD_Entry_Size, + TSD_Prologue_Size); + + 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 the call is + -- done through the Vtable (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; + Is_Static : Boolean := True); + -- Ada 2005 (AI-251): N is a type-conversion node. Reference the base of + -- the object to give access to the interface tag associated with the + -- secondary dispatch table. + + function Expand_Interface_Thunk + (N : Node_Id; + Thunk_Alias : Node_Id; + Thunk_Id : Entity_Id) return Node_Id; + -- Ada 2005 (AI-251): When a tagged type implements abstract interfaces we + -- generate additional subprograms (thunks) to have a layout compatible + -- with the C++ ABI. The thunk modifies the value of the first actual of + -- the call (that is, the pointer to the object) before transferring + -- control to the target function. + + function Fill_DT_Entry + (Loc : Source_Ptr; + Prim : Entity_Id) return Node_Id; + -- Generate the code necessary to fill the appropriate entry of the + -- dispatch table of Prim's controlling type with Prim's address. + + function Fill_Secondary_DT_Entry + (Loc : Source_Ptr; + Prim : Entity_Id; + Thunk_Id : Entity_Id; + Iface_DT_Ptr : Entity_Id) return Node_Id; + -- (Ada 2005): Generate the code necessary to fill the appropriate entry of + -- the secondary dispatch table of Prim's controlling type with Thunk_Id's + -- address. + + function Get_Remotely_Callable (Obj : Node_Id) return Node_Id; + -- Return an expression that holds True if the object can be transmitted + -- onto another partition according to E.4 (18) + + function Init_Predefined_Interface_Primitives + (Typ : Entity_Id) return List_Id; + -- Ada 2005 (AI-251): Initialize the entries associated with predefined + -- primitives in all the secondary dispatch tables of Typ. + + function Make_DT_Access_Action + (Typ : Entity_Id; + Action : DT_Access_Action; + Args : List_Id) return Node_Id; + -- Generate a call to one of the Dispatch Table Access Subprograms defined + -- in Ada.Tags or in Interfaces.Cpp + + function Make_DT (Typ : Entity_Id) return List_Id; + -- Expand the declarations for the Dispatch Table (or the Vtable in + -- the case of type whose ancestor is a CPP_Class) + + 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 the 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_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 null body if Nul + -- 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 + -- indices of primitive operations and primitive wrappers. + + procedure Make_Secondary_DT + (Typ : Entity_Id; + Ancestor_Typ : Entity_Id; + Suffix_Index : Int; + Iface : Entity_Id; + AI_Tag : Entity_Id; + Acc_Disp_Tables : in out Elist_Id; + Result : out List_Id); + -- Ada 2005 (AI-251): Expand the declarations for the Secondary Dispatch + -- Table of Typ associated with Iface (each abstract interface implemented + -- by Typ has a secondary dispatch table). The arguments Typ, Ancestor_Typ + -- and Suffix_Index are used to generate an unique external name which + -- is added at the end of Acc_Disp_Tables; this external name will be + -- used later by the subprogram Exp_Ch3.Build_Init_Procedure. + + 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_Default_Constructor (Typ : Entity_Id); + -- Typ is a CPP_Class type. Create the Init procedure of that type to + -- be the default constructor (i.e. the function returning this type, + -- having a pragma CPP_Constructor and no parameter) + + procedure Write_DT (Typ : Entity_Id); + pragma Export (Ada, Write_DT); + -- Debugging procedure (to be called within gdb) + +end Exp_Disp; |