X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fi-cpp.ads;h=74629b44261faf5d1a4b99322bd1d55d0ad4a19c;hb=f27cea3abf8ded22456f5f46a812cc3915969815;hp=6372fb5db3bafa39069b1fad72c789bb24c76687;hpb=3670c51dfe5b75666de76454dd55944799dc90b5;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/i-cpp.ads b/gcc/ada/i-cpp.ads index 6372fb5db3b..74629b44261 100644 --- a/gcc/ada/i-cpp.ads +++ b/gcc/ada/i-cpp.ads @@ -1,12 +1,12 @@ ------------------------------------------------------------------------------ -- -- --- GNAT RUNTIME COMPONENTS -- +-- GNAT RUN-TIME COMPONENTS -- -- -- -- I N T E R F A C E S . C P P -- -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2000, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -16,8 +16,8 @@ -- 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. -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, 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, -- @@ -31,163 +31,21 @@ -- -- ------------------------------------------------------------------------------ --- Definitions for interfacing to C++ classes - -with System; -with System.Storage_Elements; +-- Missing package comment ??? +with Ada.Tags; package Interfaces.CPP is +pragma Elaborate_Body; +-- We have a dummy body to deal with bootstrap path issues - 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. + subtype Vtable_Ptr is Ada.Tags.Tag; - 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) + -- These need commenting (this is not an RM package!) - type Vtable; - type Vtable_Ptr is access all Vtable; + function Expanded_Name (T : Vtable_Ptr) return String + renames Ada.Tags.Expanded_Name; - 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); + function External_Tag (T : Vtable_Ptr) return String + renames Ada.Tags.External_Tag; end Interfaces.CPP;