1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- I N T E R F A C E S . C P P --
11 -- Copyright (C) 1992-2000, Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
36 -- Definitions for interfacing to C++ classes
39 with System
.Storage_Elements
;
41 package Interfaces
.CPP
is
43 package S
renames System
;
44 package SSE
renames System
.Storage_Elements
;
46 -- This package corresponds to Ada.Tags but applied to tagged types
47 -- which are 'imported' from C++ and correspond to exactly to a C++
48 -- Class. GNAT doesn't know about the structure od the C++ dispatch
49 -- table (Vtable) but always access it through the procedural interface
50 -- defined below, thus the implementation of this package (the body) can
51 -- be customized to another C++ compiler without any change in the
52 -- compiler code itself as long as this procedural interface is
53 -- respected. Note that Ada.Tags defines a very similar procedural
54 -- interface to the regular Ada Dispatch Table.
56 type Vtable_Ptr
is private;
58 function Expanded_Name
(T
: Vtable_Ptr
) return String;
59 function External_Tag
(T
: Vtable_Ptr
) return String;
63 procedure CPP_Set_Prim_Op_Address
67 -- Given a pointer to a dispatch Table (T) and a position in the
68 -- dispatch Table put the address of the virtual function in it
69 -- (used for overriding)
71 function CPP_Get_Prim_Op_Address
75 -- Given a pointer to a dispatch Table (T) and a position in the DT
76 -- this function returns the address of the virtual function stored
77 -- in it (used for dispatching calls)
79 procedure CPP_Set_Inheritance_Depth
82 -- Given a pointer to a dispatch Table, stores the value representing
83 -- the depth in the inheritance tree. Used during elaboration of the
86 function CPP_Get_Inheritance_Depth
(T
: Vtable_Ptr
) return Natural;
87 -- Given a pointer to a dispatch Table, retreives the value representing
88 -- the depth in the inheritance tree. Used for membership.
90 procedure CPP_Set_TSD
(T
: Vtable_Ptr
; Value
: S
.Address
);
91 -- Given a pointer T to a dispatch Table, stores the address of the
92 -- record containing the Type Specific Data generated by GNAT
94 function CPP_Get_TSD
(T
: Vtable_Ptr
) return S
.Address
;
95 -- Given a pointer T to a dispatch Table, retreives the address of the
96 -- record containing the Type Specific Data generated by GNAT
98 CPP_DT_Prologue_Size
: constant SSE
.Storage_Count
:=
100 (2 * (Standard
'Address_Size / S
.Storage_Unit
));
101 -- Size of the first part of the dispatch table
103 CPP_DT_Entry_Size
: constant SSE
.Storage_Count
:=
105 (1 * (Standard
'Address_Size / S
.Storage_Unit
));
106 -- Size of each primitive operation entry in the Dispatch Table.
108 CPP_TSD_Prologue_Size
: constant SSE
.Storage_Count
:=
110 (4 * (Standard
'Address_Size / S
.Storage_Unit
));
111 -- Size of the first part of the type specific data
113 CPP_TSD_Entry_Size
: constant SSE
.Storage_Count
:=
115 (Standard
'Address_Size / S
.Storage_Unit
);
116 -- Size of each ancestor tag entry in the TSD
118 procedure CPP_Inherit_DT
121 Entry_Count
: Natural);
122 -- Entry point used to initialize the DT of a type knowing the
123 -- tag of the direct ancestor and the number of primitive ops that are
124 -- inherited (Entry_Count).
126 procedure CPP_Inherit_TSD
127 (Old_TSD
: S
.Address
;
128 New_Tag
: Vtable_Ptr
);
129 -- Entry point used to initialize the TSD of a type knowing the
130 -- TSD of the direct ancestor.
132 function CPP_CW_Membership
(Obj_Tag
, Typ_Tag
: Vtable_Ptr
) return Boolean;
133 -- Given the tag of an object and the tag associated to a type, return
134 -- true if Obj is in Typ'Class.
136 procedure CPP_Set_External_Tag
(T
: Vtable_Ptr
; Value
: S
.Address
);
137 -- Set the address of the string containing the external tag
138 -- in the Dispatch table
140 function CPP_Get_External_Tag
(T
: Vtable_Ptr
) return S
.Address
;
141 -- Retrieve the address of a null terminated string containing
144 procedure CPP_Set_Expanded_Name
(T
: Vtable_Ptr
; Value
: S
.Address
);
145 -- Set the address of the string containing the expanded name
146 -- in the Dispatch table
148 function CPP_Get_Expanded_Name
(T
: Vtable_Ptr
) return S
.Address
;
149 -- Retrieve the address of a null terminated string containing
152 procedure CPP_Set_Remotely_Callable
(T
: Vtable_Ptr
; Value
: Boolean);
153 -- Since the notions of spec/body distinction and categorized packages
154 -- do not exist in C, this procedure will do nothing
156 function CPP_Get_Remotely_Callable
(T
: Vtable_Ptr
) return Boolean;
157 -- This function will always return True for the reason explained above
159 procedure CPP_Set_RC_Offset
(T
: Vtable_Ptr
; Value
: SSE
.Storage_Offset
);
160 -- Sets the Offset of the implicit record controller when the object
161 -- has controlled components. Set to O otherwise.
163 function CPP_Get_RC_Offset
(T
: Vtable_Ptr
) return SSE
.Storage_Offset
;
164 -- Return the Offset of the implicit record controller when the object
165 -- has controlled components. O otherwise.
167 function Displaced_This
168 (Current_This
: S
.Address
;
172 -- Compute the displacement on the "this" pointer in order to be
173 -- compatible with MI.
174 -- (used for virtual function calls)
177 type Vtable_Ptr
is access all Vtable
;
179 pragma Inline
(CPP_Set_Prim_Op_Address
);
180 pragma Inline
(CPP_Get_Prim_Op_Address
);
181 pragma Inline
(CPP_Set_Inheritance_Depth
);
182 pragma Inline
(CPP_Get_Inheritance_Depth
);
183 pragma Inline
(CPP_Set_TSD
);
184 pragma Inline
(CPP_Get_TSD
);
185 pragma Inline
(CPP_Inherit_DT
);
186 pragma Inline
(CPP_CW_Membership
);
187 pragma Inline
(CPP_Set_External_Tag
);
188 pragma Inline
(CPP_Get_External_Tag
);
189 pragma Inline
(CPP_Set_Expanded_Name
);
190 pragma Inline
(CPP_Get_Expanded_Name
);
191 pragma Inline
(CPP_Set_Remotely_Callable
);
192 pragma Inline
(CPP_Get_Remotely_Callable
);
193 pragma Inline
(Displaced_This
);