| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT RUNTIME COMPONENTS -- |
| -- -- |
| -- I N T E R F A C E S . C P P -- |
| -- -- |
| -- S p e c -- |
| -- -- |
| -- $Revision: 1.12 $ |
| -- -- |
| -- Copyright (C) 1992-2000, 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, 59 Temple Place - Suite 330, Boston, -- |
| -- MA 02111-1307, USA. -- |
| -- -- |
| -- As a special exception, if other files instantiate generics from this -- |
| -- unit, or you link this unit with other files to produce an executable, -- |
| -- this unit does not by itself cause the resulting executable to be -- |
| -- covered by the GNU General Public License. This exception does not -- |
| -- however invalidate any other reasons why the executable file might be -- |
| -- covered by the GNU Public License. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| -- Definitions for interfacing to C++ classes |
| |
| with System; |
| with System.Storage_Elements; |
| |
| package Interfaces.CPP is |
| |
| package S renames System; |
| package SSE renames System.Storage_Elements; |
| |
| -- This package corresponds to Ada.Tags but applied to tagged types |
| -- which are 'imported' from C++ and correspond to exactly to a C++ |
| -- Class. GNAT doesn't know about the structure od the C++ dispatch |
| -- table (Vtable) but always access it through the procedural interface |
| -- defined below, thus the implementation of this package (the body) can |
| -- be customized to another C++ compiler without any change in the |
| -- compiler code itself as long as this procedural interface is |
| -- respected. Note that Ada.Tags defines a very similar procedural |
| -- interface to the regular Ada Dispatch Table. |
| |
| type Vtable_Ptr is private; |
| |
| function Expanded_Name (T : Vtable_Ptr) return String; |
| function External_Tag (T : Vtable_Ptr) return String; |
| |
| private |
| |
| procedure CPP_Set_Prim_Op_Address |
| (T : Vtable_Ptr; |
| Position : Positive; |
| Value : S.Address); |
| -- Given a pointer to a dispatch Table (T) and a position in the |
| -- dispatch Table put the address of the virtual function in it |
| -- (used for overriding) |
| |
| function CPP_Get_Prim_Op_Address |
| (T : Vtable_Ptr; |
| Position : Positive) |
| return S.Address; |
| -- Given a pointer to a dispatch Table (T) and a position in the DT |
| -- this function returns the address of the virtual function stored |
| -- in it (used for dispatching calls) |
| |
| procedure CPP_Set_Inheritance_Depth |
| (T : Vtable_Ptr; |
| Value : Natural); |
| -- Given a pointer to a dispatch Table, stores the value representing |
| -- the depth in the inheritance tree. Used during elaboration of the |
| -- tagged type. |
| |
| function CPP_Get_Inheritance_Depth (T : Vtable_Ptr) return Natural; |
| -- Given a pointer to a dispatch Table, retreives the value representing |
| -- the depth in the inheritance tree. Used for membership. |
| |
| procedure CPP_Set_TSD (T : Vtable_Ptr; Value : S.Address); |
| -- Given a pointer T to a dispatch Table, stores the address of the |
| -- record containing the Type Specific Data generated by GNAT |
| |
| function CPP_Get_TSD (T : Vtable_Ptr) return S.Address; |
| -- Given a pointer T to a dispatch Table, retreives the address of the |
| -- record containing the Type Specific Data generated by GNAT |
| |
| CPP_DT_Prologue_Size : constant SSE.Storage_Count := |
| SSE.Storage_Count |
| (2 * (Standard'Address_Size / S.Storage_Unit)); |
| -- Size of the first part of the dispatch table |
| |
| CPP_DT_Entry_Size : constant SSE.Storage_Count := |
| SSE.Storage_Count |
| (1 * (Standard'Address_Size / S.Storage_Unit)); |
| -- Size of each primitive operation entry in the Dispatch Table. |
| |
| CPP_TSD_Prologue_Size : constant SSE.Storage_Count := |
| SSE.Storage_Count |
| (4 * (Standard'Address_Size / S.Storage_Unit)); |
| -- Size of the first part of the type specific data |
| |
| CPP_TSD_Entry_Size : constant SSE.Storage_Count := |
| SSE.Storage_Count |
| (Standard'Address_Size / S.Storage_Unit); |
| -- Size of each ancestor tag entry in the TSD |
| |
| procedure CPP_Inherit_DT |
| (Old_T : Vtable_Ptr; |
| New_T : Vtable_Ptr; |
| Entry_Count : Natural); |
| -- Entry point used to initialize the DT of a type knowing the |
| -- tag of the direct ancestor and the number of primitive ops that are |
| -- inherited (Entry_Count). |
| |
| procedure CPP_Inherit_TSD |
| (Old_TSD : S.Address; |
| New_Tag : Vtable_Ptr); |
| -- Entry point used to initialize the TSD of a type knowing the |
| -- TSD of the direct ancestor. |
| |
| function CPP_CW_Membership (Obj_Tag, Typ_Tag : Vtable_Ptr) return Boolean; |
| -- Given the tag of an object and the tag associated to a type, return |
| -- true if Obj is in Typ'Class. |
| |
| procedure CPP_Set_External_Tag (T : Vtable_Ptr; Value : S.Address); |
| -- Set the address of the string containing the external tag |
| -- in the Dispatch table |
| |
| function CPP_Get_External_Tag (T : Vtable_Ptr) return S.Address; |
| -- Retrieve the address of a null terminated string containing |
| -- the external name |
| |
| procedure CPP_Set_Expanded_Name (T : Vtable_Ptr; Value : S.Address); |
| -- Set the address of the string containing the expanded name |
| -- in the Dispatch table |
| |
| function CPP_Get_Expanded_Name (T : Vtable_Ptr) return S.Address; |
| -- Retrieve the address of a null terminated string containing |
| -- the expanded name |
| |
| procedure CPP_Set_Remotely_Callable (T : Vtable_Ptr; Value : Boolean); |
| -- Since the notions of spec/body distinction and categorized packages |
| -- do not exist in C, this procedure will do nothing |
| |
| function CPP_Get_Remotely_Callable (T : Vtable_Ptr) return Boolean; |
| -- This function will always return True for the reason explained above |
| |
| procedure CPP_Set_RC_Offset (T : Vtable_Ptr; Value : SSE.Storage_Offset); |
| -- Sets the Offset of the implicit record controller when the object |
| -- has controlled components. Set to O otherwise. |
| |
| function CPP_Get_RC_Offset (T : Vtable_Ptr) return SSE.Storage_Offset; |
| -- Return the Offset of the implicit record controller when the object |
| -- has controlled components. O otherwise. |
| |
| function Displaced_This |
| (Current_This : S.Address; |
| Vptr : Vtable_Ptr; |
| Position : Positive) |
| return S.Address; |
| -- Compute the displacement on the "this" pointer in order to be |
| -- compatible with MI. |
| -- (used for virtual function calls) |
| |
| type Vtable; |
| type Vtable_Ptr is access all Vtable; |
| |
| pragma Inline (CPP_Set_Prim_Op_Address); |
| pragma Inline (CPP_Get_Prim_Op_Address); |
| pragma Inline (CPP_Set_Inheritance_Depth); |
| pragma Inline (CPP_Get_Inheritance_Depth); |
| pragma Inline (CPP_Set_TSD); |
| pragma Inline (CPP_Get_TSD); |
| pragma Inline (CPP_Inherit_DT); |
| pragma Inline (CPP_CW_Membership); |
| pragma Inline (CPP_Set_External_Tag); |
| pragma Inline (CPP_Get_External_Tag); |
| pragma Inline (CPP_Set_Expanded_Name); |
| pragma Inline (CPP_Get_Expanded_Name); |
| pragma Inline (CPP_Set_Remotely_Callable); |
| pragma Inline (CPP_Get_Remotely_Callable); |
| pragma Inline (Displaced_This); |
| |
| end Interfaces.CPP; |
