return TSD (T).Remotely_Callable = True;
end Get_Remotely_Callable;
- -------------
- -- Get_TSD --
- -------------
-
- function Get_TSD (T : Tag) return System.Address is
- use type System.Storage_Elements.Storage_Offset;
- TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
- begin
- return TSD_Ptr.all;
- end Get_TSD;
-
----------------
-- Inherit_DT --
----------------
-- Inherit_TSD --
-----------------
- procedure Inherit_TSD (Old_TSD : System.Address; New_Tag : Tag) is
- Old_TSD_Ptr : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (Old_TSD);
- New_TSD_Ptr : constant Type_Specific_Data_Ptr :=
- TSD (New_Tag);
+ procedure Inherit_TSD (Old_Tag : Tag; New_Tag : Tag) is
+ New_TSD_Ptr : constant Type_Specific_Data_Ptr := TSD (New_Tag);
+ Old_TSD_Ptr : Type_Specific_Data_Ptr;
begin
- if Old_TSD_Ptr /= null then
+ if Old_Tag /= null then
+ Old_TSD_Ptr := TSD (Old_Tag);
New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1;
New_TSD_Ptr.Ancestor_Tags (1 .. New_TSD_Ptr.Idepth) :=
Old_TSD_Ptr.Ancestor_Tags (0 .. Old_TSD_Ptr.Idepth);
---------
function TSD (T : Tag) return Type_Specific_Data_Ptr is
+ use type System.Storage_Elements.Storage_Offset;
+ TSD_Ptr : constant Addr_Ptr :=
+ To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
begin
- return To_Type_Specific_Data_Ptr (Get_TSD (T));
+ return To_Type_Specific_Data_Ptr (TSD_Ptr.all);
end TSD;
end Ada.Tags;
function Get_Remotely_Callable (T : Tag) return Boolean;
-- Return the value previously set by Set_Remotely_Callable
- function Get_TSD (T : Tag) return System.Address;
- -- Given a pointer T to a dispatch Table, retreives the address of the
- -- record containing the Type Specific Data generated by GNAT
-
procedure Inherit_DT
(Old_T : Tag;
New_T : Tag;
-- of the direct ancestor and the number of primitive ops that are
-- inherited (Entry_Count).
- procedure Inherit_TSD (Old_TSD : System.Address; New_Tag : Tag);
- -- Entry point used to initialize the TSD of a type knowing the
- -- TSD of the direct ancestor.
+ procedure Inherit_TSD (Old_Tag : Tag; New_Tag : Tag);
+ -- Initialize the TSD of a type knowing the tag of the direct ancestor
function Parent_Size
(Obj : System.Address;
-- in E.4 (18).
function TSD (T : Tag) return Type_Specific_Data_Ptr;
- -- This function is conceptually equivalent to Get_TSD, but
- -- returning a Type_Specific_Data_Ptr type (rather than an Address)
- -- simplifies the implementation of the other subprograms.
+ -- Given a pointer T to a dispatch Table, retreives the address of the
+ -- record containing the Type Specific Data generated by GNAT
DT_Prologue_Size : constant SSE.Storage_Count :=
SSE.Storage_Count
pragma Inline_Always (Get_Prim_Op_Address);
pragma Inline_Always (Get_RC_Offset);
pragma Inline_Always (Get_Remotely_Callable);
- pragma Inline_Always (Get_TSD);
pragma Inline_Always (Inherit_DT);
pragma Inline_Always (Inherit_TSD);
pragma Inline_Always (Register_Tag);
Get_Prim_Op_Address => RE_Get_Prim_Op_Address,
Get_RC_Offset => RE_Get_RC_Offset,
Get_Remotely_Callable => RE_Get_Remotely_Callable,
- Get_TSD => RE_Get_TSD,
Inherit_DT => RE_Inherit_DT,
Inherit_TSD => RE_Inherit_TSD,
Register_Tag => RE_Register_Tag,
Get_Prim_Op_Address => RE_CPP_Get_Prim_Op_Address,
Get_RC_Offset => RE_CPP_Get_RC_Offset,
Get_Remotely_Callable => RE_CPP_Get_Remotely_Callable,
- Get_TSD => RE_CPP_Get_TSD,
Inherit_DT => RE_CPP_Inherit_DT,
Inherit_TSD => RE_CPP_Inherit_TSD,
Register_Tag => RE_CPP_Register_Tag,
Get_Prim_Op_Address => False,
Get_Remotely_Callable => False,
Get_RC_Offset => False,
- Get_TSD => False,
Inherit_DT => True,
Inherit_TSD => True,
Register_Tag => True,
Get_Prim_Op_Address => 2,
Get_RC_Offset => 1,
Get_Remotely_Callable => 1,
- Get_TSD => 1,
Inherit_DT => 3,
Inherit_TSD => 2,
Register_Tag => 1,
I_Depth : Int;
Generalized_Tag : Entity_Id;
Size_Expr_Node : Node_Id;
- Old_Tag : Node_Id;
- Old_TSD : Node_Id;
+ Old_Tag1 : Node_Id;
+ Old_Tag2 : Node_Id;
begin
if not RTE_Available (RE_Tag) then
if Typ = Etype (Typ)
or else Is_CPP_Class (Etype (Typ))
then
- Old_Tag :=
+ Old_Tag1 :=
Unchecked_Convert_To (Generalized_Tag,
Make_Integer_Literal (Loc, 0));
-
- Old_TSD :=
- Unchecked_Convert_To (RTE (RE_Address),
+ Old_Tag2 :=
+ Unchecked_Convert_To (Generalized_Tag,
Make_Integer_Literal (Loc, 0));
else
- Old_Tag :=
+ Old_Tag1 :=
+ New_Reference_To
+ (Node (First_Elmt (Access_Disp_Table (Etype (Typ)))), Loc);
+ Old_Tag2 :=
New_Reference_To
(Node (First_Elmt (Access_Disp_Table (Etype (Typ)))), Loc);
- Old_TSD :=
- Make_DT_Access_Action (Typ,
- Action => Get_TSD,
- Args => New_List (
- New_Reference_To
- (Node (First_Elmt (Access_Disp_Table (Etype (Typ)))), Loc)));
end if;
-- Generate: Inherit_DT (parent'tag, DT_Ptr, nb_prim of parent);
Make_DT_Access_Action (Typ,
Action => Inherit_DT,
Args => New_List (
- Node1 => Old_Tag,
+ Node1 => Old_Tag1,
Node2 => New_Reference_To (DT_Ptr, Loc),
Node3 => Make_Integer_Literal (Loc,
DT_Entry_Count (First_Tag_Component (Etype (Typ)))))));
- -- Generate: Inherit_TSD (Get_TSD (parent), DT_Ptr);
+ -- Generate: Inherit_TSD (parent'tag, DT_Ptr);
Append_To (Elab_Code,
Make_DT_Access_Action (Typ,
Action => Inherit_TSD,
Args => New_List (
- Node1 => Old_TSD,
+ Node1 => Old_Tag2,
Node2 => New_Reference_To (DT_Ptr, Loc))));
-- Generate: Exname : constant String := full_qualified_name (typ);
Get_Prim_Op_Address,
Get_RC_Offset,
Get_Remotely_Callable,
- Get_TSD,
Inherit_DT,
Inherit_TSD,
Register_Tag,
return True;
end CPP_Get_Remotely_Callable;
- -----------------
- -- CPP_Get_TSD --
- -----------------
-
- function CPP_Get_TSD (T : Vtable_Ptr) return Address is
- use type System.Storage_Elements.Storage_Offset;
- TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (T) - CPP_DT_Typeinfo_Ptr_Size);
- begin
- return TSD_Ptr.all;
- end CPP_Get_TSD;
-
--------------------
-- CPP_Inherit_DT --
--------------------
---------------------
procedure CPP_Inherit_TSD
- (Old_TSD : Address;
+ (Old_Tag : Vtable_Ptr;
New_Tag : Vtable_Ptr)
is
- Old_TSD_Ptr : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (Old_TSD);
-
- New_TSD_Ptr : constant Type_Specific_Data_Ptr :=
- TSD (New_Tag);
+ New_TSD_Ptr : constant Type_Specific_Data_Ptr := TSD (New_Tag);
+ Old_TSD_Ptr : Type_Specific_Data_Ptr;
begin
- if Old_TSD_Ptr /= null then
+ if Old_Tag /= null then
+ Old_TSD_Ptr := TSD (Old_Tag);
New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1;
New_TSD_Ptr.Ancestor_Tags (1 .. New_TSD_Ptr.Idepth) :=
Old_TSD_Ptr.Ancestor_Tags (0 .. Old_TSD_Ptr.Idepth);
---------
function TSD (T : Vtable_Ptr) return Type_Specific_Data_Ptr is
+ use type System.Storage_Elements.Storage_Offset;
+ TSD_Ptr : constant Addr_Ptr :=
+ To_Addr_Ptr (To_Address (T) - CPP_DT_Typeinfo_Ptr_Size);
begin
- return To_Type_Specific_Data_Ptr (CPP_Get_TSD (T));
+ return To_Type_Specific_Data_Ptr (TSD_Ptr.all);
end TSD;
end Interfaces.CPP;
-- 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));
-- inherited (Entry_Count).
procedure CPP_Inherit_TSD
- (Old_TSD : S.Address;
+ (Old_Tag : Vtable_Ptr;
New_Tag : Vtable_Ptr);
-- Entry point used to initialize the TSD of a type knowing the
-- TSD of the direct ancestor.
-- (used for virtual function calls)
function TSD (T : Vtable_Ptr) return Type_Specific_Data_Ptr;
- -- This function is conceptually equivalent to Get_TSD, but
- -- returning a Type_Specific_Data_Ptr type (rather than an Address)
- -- simplifies the implementation of the other subprograms.
+ -- Given a pointer T to a dispatch Table, retreives the address of the
+ -- record containing the Type Specific Data generated by GNAT
type Addr_Ptr is access System.Address;
pragma Inline (CPP_Set_Prim_Op_Address);
pragma Inline (CPP_Get_Prim_Op_Address);
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);
RE_Get_Prim_Op_Address, -- Ada.Tags
RE_Get_RC_Offset, -- Ada.Tags
RE_Get_Remotely_Callable, -- Ada.Tags
- RE_Get_TSD, -- Ada.Tags
RE_Inherit_DT, -- Ada.Tags
RE_Inherit_TSD, -- Ada.Tags
RE_Internal_Tag, -- Ada.Tags
RE_CPP_Get_Prim_Op_Address, -- Interfaces.CPP
RE_CPP_Get_RC_Offset, -- Interfaces.CPP
RE_CPP_Get_Remotely_Callable, -- Interfaces.CPP
- RE_CPP_Get_TSD, -- Interfaces.CPP
RE_CPP_Inherit_DT, -- Interfaces.CPP
RE_CPP_Inherit_TSD, -- Interfaces.CPP
RE_CPP_Register_Tag, -- Interfaces.CPP
RE_Get_Prim_Op_Address => Ada_Tags,
RE_Get_RC_Offset => Ada_Tags,
RE_Get_Remotely_Callable => Ada_Tags,
- RE_Get_TSD => Ada_Tags,
RE_Inherit_DT => Ada_Tags,
RE_Inherit_TSD => Ada_Tags,
RE_Internal_Tag => Ada_Tags,
RE_CPP_Get_Prim_Op_Address => Interfaces_CPP,
RE_CPP_Get_RC_Offset => Interfaces_CPP,
RE_CPP_Get_Remotely_Callable => Interfaces_CPP,
- RE_CPP_Get_TSD => Interfaces_CPP,
RE_CPP_Inherit_DT => Interfaces_CPP,
RE_CPP_Inherit_TSD => Interfaces_CPP,
RE_CPP_Register_Tag => Interfaces_CPP,