Package Name: interfaces.cpp
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- I N T E R F A C E S . C P P --
-- --
-- S p e c --
-- --
-- $Revision: 1.8 $ --
-- --
-- Copyright (C) 1992,1993,1994,1995,1996 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. --
-- --
-- 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
(2 * (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;
-- retreive 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;
-- retreive the address of a null terminated string containing
-- the expanded name
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 (Displaced_This);
end Interfaces.CPP;