1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
------------------------------------------------------------------------------
-- --
-- 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
-- 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
Default_Prim_Op_Count : constant Int := 14;
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_Prim_Op_Address,
Get_Prim_Op_Kind,
Get_RC_Offset,
Get_Remotely_Callable,
Inherit_DT,
Inherit_TSD,
Register_Interface_Tag,
Register_Tag,
Set_Access_Level,
Set_Entry_Index,
Set_Expanded_Name,
Set_External_Tag,
Set_Prim_Op_Address,
Set_Prim_Op_Kind,
Set_RC_Offset,
Set_Remotely_Callable,
Set_TSD,
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);
-- 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;
Thunk_Tag : 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.
procedure Make_Abstract_Interface_DT
(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
-- Tables corresponding with an abstract interface. The reference to the
-- dispatch table is appended at the end of Acc_Disp_Tables; it will be
-- are later used to generate the corresponding initialization statement
-- (see Exp_Ch3.Build_Init_Procedure).
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.
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.
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.
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_Select_Tables
(Typ : Entity_Id) return List_Id;
-- Ada 2005 (AI-345): Populate the two auxiliary tables 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.
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.
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.
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;
|
