1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- I N T E R F A C E S . C P P --
9 -- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- Definitions for interfacing to C++ classes
36 -- This package corresponds to Ada.Tags but applied to tagged types which are
37 -- are imported from C++ and correspond exactly to a C++ Class. The code that
38 -- the GNAT front end generates does not know about the structure of the C++
39 -- dispatch table (Vtable) but always accesses it through the procedural
40 -- interface defined in this package, thus the implementation of this package
41 -- (the body) can be customized to another C++ compiler without any change in
42 -- the compiler code itself as long as this procedural interface is respected.
43 -- Note that Ada.Tags defines a very similar procedural interface to the
44 -- regular Ada Dispatch Table.
47 with System
.Storage_Elements
;
49 package Interfaces
.CPP
is
51 package S
renames System
;
52 package SSE
renames System
.Storage_Elements
;
54 type Vtable_Ptr
is private;
56 function Expanded_Name
(T
: Vtable_Ptr
) return String;
57 function External_Tag
(T
: Vtable_Ptr
) return String;
60 -- These subprograms are in the private part. They are never accessed
61 -- directly except from compiler generated code, which has access to
62 -- private components of packages via the Rtsfind interface.
64 procedure CPP_Set_Prim_Op_Address
68 -- Given a pointer to a dispatch Table (T) and a position in the
69 -- dispatch Table put the address of the virtual function in it
70 -- (used for overriding)
72 function CPP_Get_Prim_Op_Address
76 -- Given a pointer to a dispatch Table (T) and a position in the DT
77 -- this function returns the address of the virtual function stored
78 -- in it (used for dispatching calls)
80 procedure CPP_Set_Inheritance_Depth
83 -- Given a pointer to a dispatch Table, stores the value representing
84 -- the depth in the inheritance tree. Used during elaboration of the
87 function CPP_Get_Inheritance_Depth
(T
: Vtable_Ptr
) return Natural;
88 -- Given a pointer to a dispatch Table, retreives the value representing
89 -- the depth in the inheritance tree. Used for membership.
91 procedure CPP_Set_TSD
(T
: Vtable_Ptr
; Value
: S
.Address
);
92 -- Given a pointer T to a dispatch Table, stores the address of the
93 -- record containing the Type Specific Data generated by GNAT
95 function CPP_Get_TSD
(T
: Vtable_Ptr
) return S
.Address
;
96 -- Given a pointer T to a dispatch Table, retreives the address of the
97 -- record containing the Type Specific Data generated by GNAT
99 CPP_DT_Prologue_Size
: constant SSE
.Storage_Count
:=
101 (1 * (Standard
'Address_Size / S
.Storage_Unit
));
102 -- Size of the first part of the dispatch table
104 CPP_DT_Entry_Size
: constant SSE
.Storage_Count
:=
106 (1 * (Standard
'Address_Size / S
.Storage_Unit
));
107 -- Size of each primitive operation entry in the Dispatch Table.
109 CPP_TSD_Prologue_Size
: constant SSE
.Storage_Count
:=
111 (4 * (Standard
'Address_Size / S
.Storage_Unit
));
112 -- Size of the first part of the type specific data
114 CPP_TSD_Entry_Size
: constant SSE
.Storage_Count
:=
116 (1 * (Standard
'Address_Size / S
.Storage_Unit
));
117 -- Size of each ancestor tag entry in the TSD
119 procedure CPP_Inherit_DT
122 Entry_Count
: Natural);
123 -- Entry point used to initialize the DT of a type knowing the
124 -- tag of the direct ancestor and the number of primitive ops that are
125 -- inherited (Entry_Count).
127 procedure CPP_Inherit_TSD
128 (Old_TSD
: S
.Address
;
129 New_Tag
: Vtable_Ptr
);
130 -- Entry point used to initialize the TSD of a type knowing the
131 -- TSD of the direct ancestor.
133 function CPP_CW_Membership
(Obj_Tag
, Typ_Tag
: Vtable_Ptr
) return Boolean;
134 -- Given the tag of an object and the tag associated to a type, return
135 -- true if Obj is in Typ'Class.
137 procedure CPP_Set_External_Tag
(T
: Vtable_Ptr
; Value
: S
.Address
);
138 -- Set the address of the string containing the external tag
139 -- in the Dispatch table
141 function CPP_Get_External_Tag
(T
: Vtable_Ptr
) return S
.Address
;
142 -- Retrieve the address of a null terminated string containing
145 procedure CPP_Set_Expanded_Name
(T
: Vtable_Ptr
; Value
: S
.Address
);
146 -- Set the address of the string containing the expanded name
147 -- in the Dispatch table
149 function CPP_Get_Expanded_Name
(T
: Vtable_Ptr
) return S
.Address
;
150 -- Retrieve the address of a null terminated string containing
153 procedure CPP_Set_Remotely_Callable
(T
: Vtable_Ptr
; Value
: Boolean);
154 -- Since the notions of spec/body distinction and categorized packages
155 -- do not exist in C, this procedure will do nothing
157 function CPP_Get_Remotely_Callable
(T
: Vtable_Ptr
) return Boolean;
158 -- This function will always return True for the reason explained above
160 procedure CPP_Set_RC_Offset
(T
: Vtable_Ptr
; Value
: SSE
.Storage_Offset
);
161 -- Sets the Offset of the implicit record controller when the object
162 -- has controlled components. Set to O otherwise.
164 function CPP_Get_RC_Offset
(T
: Vtable_Ptr
) return SSE
.Storage_Offset
;
165 -- Return the Offset of the implicit record controller when the object
166 -- has controlled components. O otherwise.
168 function Displaced_This
169 (Current_This
: S
.Address
;
173 -- Compute the displacement on the "this" pointer in order to be
174 -- compatible with MI.
175 -- (used for virtual function calls)
178 type Vtable_Ptr
is access all Vtable
;
180 pragma Inline
(CPP_Set_Prim_Op_Address
);
181 pragma Inline
(CPP_Get_Prim_Op_Address
);
182 pragma Inline
(CPP_Set_Inheritance_Depth
);
183 pragma Inline
(CPP_Get_Inheritance_Depth
);
184 pragma Inline
(CPP_Set_TSD
);
185 pragma Inline
(CPP_Get_TSD
);
186 pragma Inline
(CPP_Inherit_DT
);
187 pragma Inline
(CPP_CW_Membership
);
188 pragma Inline
(CPP_Set_External_Tag
);
189 pragma Inline
(CPP_Get_External_Tag
);
190 pragma Inline
(CPP_Set_Expanded_Name
);
191 pragma Inline
(CPP_Get_Expanded_Name
);
192 pragma Inline
(CPP_Set_Remotely_Callable
);
193 pragma Inline
(CPP_Get_Remotely_Callable
);
194 pragma Inline
(Displaced_This
);