1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- I N T E R F A C E S . C P P --
9 -- Copyright (C) 1992-2005, 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
;
48 with Unchecked_Conversion
;
50 package Interfaces
.CPP
is
52 type Vtable_Ptr
is private;
54 function Expanded_Name
(T
: Vtable_Ptr
) return String;
55 function External_Tag
(T
: Vtable_Ptr
) return String;
58 package S
renames System
;
59 package SSE
renames System
.Storage_Elements
;
62 type Vtable_Ptr
is access all Vtable
;
64 type Type_Specific_Data
;
65 type Type_Specific_Data_Ptr
is access all Type_Specific_Data
;
67 -- These subprograms are in the private part. They are never accessed
68 -- directly except from compiler generated code, which has access to
69 -- private components of packages via the Rtsfind interface.
71 procedure CPP_Set_Prim_Op_Address
75 -- Given a pointer to a dispatch Table (T) and a position in the
76 -- dispatch Table put the address of the virtual function in it
77 -- (used for overriding)
79 function CPP_Get_Prim_Op_Address
83 -- Given a pointer to a dispatch Table (T) and a position in the DT
84 -- this function returns the address of the virtual function stored
85 -- in it (used for dispatching calls)
87 procedure CPP_Set_TSD
(T
: Vtable_Ptr
; Value
: S
.Address
);
88 -- Given a pointer T to a dispatch Table, stores the address of the
89 -- record containing the Type Specific Data generated by GNAT
91 CPP_DT_Prologue_Size
: constant SSE
.Storage_Count
:=
93 (2 * (Standard
'Address_Size / S
.Storage_Unit
));
94 -- Size of the first part of the dispatch table
96 CPP_DT_Typeinfo_Ptr_Size
: constant SSE
.Storage_Count
:=
98 (Standard
'Address_Size / System
.Storage_Unit
);
99 -- Size of the Typeinfo_Ptr field of the Dispatch Table.
101 CPP_DT_Entry_Size
: constant SSE
.Storage_Count
:=
103 (1 * (Standard
'Address_Size / S
.Storage_Unit
));
104 -- Size of each primitive operation entry in the Dispatch Table.
106 CPP_TSD_Prologue_Size
: constant SSE
.Storage_Count
:=
108 (4 * (Standard
'Address_Size / S
.Storage_Unit
));
109 -- Size of the first part of the type specific data
111 CPP_TSD_Entry_Size
: constant SSE
.Storage_Count
:=
113 (1 * (Standard
'Address_Size / S
.Storage_Unit
));
114 -- Size of each ancestor tag entry in the TSD
116 procedure CPP_Inherit_DT
119 Entry_Count
: Natural);
120 -- Entry point used to initialize the DT of a type knowing the
121 -- tag of the direct ancestor and the number of primitive ops that are
122 -- inherited (Entry_Count).
124 procedure CPP_Inherit_TSD
125 (Old_Tag
: Vtable_Ptr
;
126 New_Tag
: Vtable_Ptr
);
127 -- Entry point used to initialize the TSD of a type knowing the
128 -- TSD of the direct ancestor.
130 function CPP_CW_Membership
(Obj_Tag
, Typ_Tag
: Vtable_Ptr
) return Boolean;
131 -- Given the tag of an object and the tag associated to a type, return
132 -- true if Obj is in Typ'Class.
134 procedure CPP_Set_External_Tag
(T
: Vtable_Ptr
; Value
: S
.Address
);
135 -- Set the address of the string containing the external tag
136 -- in the Dispatch table
138 function CPP_Get_External_Tag
(T
: Vtable_Ptr
) return S
.Address
;
139 -- Retrieve the address of a null terminated string containing
142 procedure CPP_Set_Expanded_Name
(T
: Vtable_Ptr
; Value
: S
.Address
);
143 -- Set the address of the string containing the expanded name
144 -- in the Dispatch table
146 procedure CPP_Set_Remotely_Callable
(T
: Vtable_Ptr
; Value
: Boolean);
147 -- Since the notions of spec/body distinction and categorized packages
148 -- do not exist in C, this procedure will do nothing
150 function CPP_Get_Remotely_Callable
(T
: Vtable_Ptr
) return Boolean;
151 -- This function will always return True for the reason explained above
153 procedure CPP_Set_RC_Offset
(T
: Vtable_Ptr
; Value
: SSE
.Storage_Offset
);
154 -- Sets the Offset of the implicit record controller when the object
155 -- has controlled components. Set to O otherwise.
157 function CPP_Get_RC_Offset
(T
: Vtable_Ptr
) return SSE
.Storage_Offset
;
158 -- Return the Offset of the implicit record controller when the object
159 -- has controlled components. O otherwise.
161 function Displaced_This
162 (Current_This
: S
.Address
;
166 -- Compute the displacement on the "this" pointer in order to be
167 -- compatible with MI.
168 -- (used for virtual function calls)
170 function TSD
(T
: Vtable_Ptr
) return Type_Specific_Data_Ptr
;
171 -- Given a pointer T to a dispatch Table, retreives the address of the
172 -- record containing the Type Specific Data generated by GNAT
174 type Addr_Ptr
is access System
.Address
;
176 function To_Address
is
177 new Unchecked_Conversion
(Vtable_Ptr
, System
.Address
);
179 function To_Addr_Ptr
is
180 new Unchecked_Conversion
(System
.Address
, Addr_Ptr
);
182 function To_Type_Specific_Data_Ptr
is
183 new Unchecked_Conversion
(System
.Address
, Type_Specific_Data_Ptr
);
185 pragma Inline
(CPP_Set_Prim_Op_Address
);
186 pragma Inline
(CPP_Get_Prim_Op_Address
);
187 pragma Inline
(CPP_Set_TSD
);
188 pragma Inline
(CPP_Inherit_DT
);
189 pragma Inline
(CPP_CW_Membership
);
190 pragma Inline
(CPP_Set_External_Tag
);
191 pragma Inline
(CPP_Get_External_Tag
);
192 pragma Inline
(CPP_Set_Expanded_Name
);
193 pragma Inline
(CPP_Set_Remotely_Callable
);
194 pragma Inline
(CPP_Get_Remotely_Callable
);
195 pragma Inline
(Displaced_This
);