1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- I N T E R F A C E S . C P P --
9 -- Copyright (C) 1992-2000, 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
37 with System
.Storage_Elements
;
39 package Interfaces
.CPP
is
41 package S
renames System
;
42 package SSE
renames System
.Storage_Elements
;
44 -- This package corresponds to Ada.Tags but applied to tagged types
45 -- which are 'imported' from C++ and correspond to exactly to a C++
46 -- Class. GNAT doesn't know about the structure od the C++ dispatch
47 -- table (Vtable) but always access it through the procedural interface
48 -- defined below, thus the implementation of this package (the body) can
49 -- be customized to another C++ compiler without any change in the
50 -- compiler code itself as long as this procedural interface is
51 -- respected. Note that Ada.Tags defines a very similar procedural
52 -- interface to the regular Ada Dispatch Table.
54 type Vtable_Ptr
is private;
56 function Expanded_Name
(T
: Vtable_Ptr
) return String;
57 function External_Tag
(T
: Vtable_Ptr
) return String;
61 procedure CPP_Set_Prim_Op_Address
65 -- Given a pointer to a dispatch Table (T) and a position in the
66 -- dispatch Table put the address of the virtual function in it
67 -- (used for overriding)
69 function CPP_Get_Prim_Op_Address
73 -- Given a pointer to a dispatch Table (T) and a position in the DT
74 -- this function returns the address of the virtual function stored
75 -- in it (used for dispatching calls)
77 procedure CPP_Set_Inheritance_Depth
80 -- Given a pointer to a dispatch Table, stores the value representing
81 -- the depth in the inheritance tree. Used during elaboration of the
84 function CPP_Get_Inheritance_Depth
(T
: Vtable_Ptr
) return Natural;
85 -- Given a pointer to a dispatch Table, retreives the value representing
86 -- the depth in the inheritance tree. Used for membership.
88 procedure CPP_Set_TSD
(T
: Vtable_Ptr
; Value
: S
.Address
);
89 -- Given a pointer T to a dispatch Table, stores the address of the
90 -- record containing the Type Specific Data generated by GNAT
92 function CPP_Get_TSD
(T
: Vtable_Ptr
) return S
.Address
;
93 -- Given a pointer T to a dispatch Table, retreives the address of the
94 -- record containing the Type Specific Data generated by GNAT
96 CPP_DT_Prologue_Size
: constant SSE
.Storage_Count
:=
98 (2 * (Standard
'Address_Size / S
.Storage_Unit
));
99 -- Size of the first part 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 (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_TSD
: S
.Address
;
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 function CPP_Get_Expanded_Name
(T
: Vtable_Ptr
) return S
.Address
;
147 -- Retrieve the address of a null terminated string containing
150 procedure CPP_Set_Remotely_Callable
(T
: Vtable_Ptr
; Value
: Boolean);
151 -- Since the notions of spec/body distinction and categorized packages
152 -- do not exist in C, this procedure will do nothing
154 function CPP_Get_Remotely_Callable
(T
: Vtable_Ptr
) return Boolean;
155 -- This function will always return True for the reason explained above
157 procedure CPP_Set_RC_Offset
(T
: Vtable_Ptr
; Value
: SSE
.Storage_Offset
);
158 -- Sets the Offset of the implicit record controller when the object
159 -- has controlled components. Set to O otherwise.
161 function CPP_Get_RC_Offset
(T
: Vtable_Ptr
) return SSE
.Storage_Offset
;
162 -- Return the Offset of the implicit record controller when the object
163 -- has controlled components. O otherwise.
165 function Displaced_This
166 (Current_This
: S
.Address
;
170 -- Compute the displacement on the "this" pointer in order to be
171 -- compatible with MI.
172 -- (used for virtual function calls)
175 type Vtable_Ptr
is access all Vtable
;
177 pragma Inline
(CPP_Set_Prim_Op_Address
);
178 pragma Inline
(CPP_Get_Prim_Op_Address
);
179 pragma Inline
(CPP_Set_Inheritance_Depth
);
180 pragma Inline
(CPP_Get_Inheritance_Depth
);
181 pragma Inline
(CPP_Set_TSD
);
182 pragma Inline
(CPP_Get_TSD
);
183 pragma Inline
(CPP_Inherit_DT
);
184 pragma Inline
(CPP_CW_Membership
);
185 pragma Inline
(CPP_Set_External_Tag
);
186 pragma Inline
(CPP_Get_External_Tag
);
187 pragma Inline
(CPP_Set_Expanded_Name
);
188 pragma Inline
(CPP_Get_Expanded_Name
);
189 pragma Inline
(CPP_Set_Remotely_Callable
);
190 pragma Inline
(CPP_Get_Remotely_Callable
);
191 pragma Inline
(Displaced_This
);