This patch modifies the initialization of the offset_to_top field of
secondary dispatch tables to store negative offsets, thus improving
the layout compatibility of secondary dispatch tables with C++.
No functionality change.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-11-09 Javier Miranda <mira...@adacore.com>
* exp_disp.adb (Expand_Interface_Thunk): Replace substraction of
offset-to-top field by addition.
(Make_Secondary_DT): Initialize the offset-to-top field with a negative
offset.
* exp_ch3.adb (Build_Offset_To_Top_Function): Build functions that
return a negative offset-to-top value.
(Initialize_Tag): Invoke runtime services Set_Dynamic_Offset_To_Top and
Set_Static_Offset_To_Top passing a negative offet-to-top value;
initialize also the offset-to-top field with a negative offset.
* libgnat/a-tags.adb (Base_Address): Displace the pointer by means of
an addition since the offset-to-top field is now a negative value.
(Displace): Displace the pointer to the object means of a substraction
since it is now a negative value.
(Set_Dynamic_Offset_to_top): Displace the pointer to the object by
means of a substraction since it is now a negative value.
Index: libgnat/a-tags.adb
===================================================================
--- libgnat/a-tags.adb (revision 254563)
+++ libgnat/a-tags.adb (working copy)
@@ -332,7 +332,7 @@
function Base_Address (This : System.Address) return System.Address is
begin
- return This - Offset_To_Top (This);
+ return This + Offset_To_Top (This);
end Base_Address;
---------------
@@ -412,14 +412,14 @@
-- Case of Static value of Offset_To_Top
if Iface_Table.Ifaces_Table (Id).Static_Offset_To_Top then
- Obj_Base := Obj_Base +
+ Obj_Base := Obj_Base -
Iface_Table.Ifaces_Table (Id).Offset_To_Top_Value;
-- Otherwise call the function generated by the expander to
-- provide the value.
else
- Obj_Base := Obj_Base +
+ Obj_Base := Obj_Base -
Iface_Table.Ifaces_Table (Id).Offset_To_Top_Func.all
(Obj_Base);
end if;
@@ -1046,7 +1046,7 @@
-- Save the offset to top field in the secondary dispatch table
if Offset_Value /= 0 then
- Sec_Base := This + Offset_Value;
+ Sec_Base := This - Offset_Value;
Sec_DT := DT (To_Tag_Ptr (Sec_Base).all);
Sec_DT.Offset_To_Top := SSE.Storage_Offset'Last;
end if;
Index: exp_disp.adb
===================================================================
--- exp_disp.adb (revision 254563)
+++ exp_disp.adb (working copy)
@@ -1884,7 +1884,7 @@
-- Generate:
-- type T is access all <<type of the target formal>>
-- S : Storage_Offset := Storage_Offset!(Formal)
- -- - Offset_To_Top (address!(Formal))
+ -- + Offset_To_Top (address!(Formal))
Decl_2 :=
Make_Full_Type_Declaration (Loc,
@@ -1918,7 +1918,7 @@
Object_Definition =>
New_Occurrence_Of (RTE (RE_Storage_Offset), Loc),
Expression =>
- Make_Op_Subtract (Loc,
+ Make_Op_Add (Loc,
Left_Opnd =>
Unchecked_Convert_To
(RTE (RE_Storage_Offset),
@@ -1942,7 +1942,7 @@
-- Generate:
-- S1 : Storage_Offset := Storage_Offset!(Formal'Address)
- -- - Offset_To_Top (Formal'Address)
+ -- + Offset_To_Top (Formal'Address)
-- S2 : Addr_Ptr := Addr_Ptr!(S1)
New_Arg :=
@@ -1969,7 +1969,7 @@
Object_Definition =>
New_Occurrence_Of (RTE (RE_Storage_Offset), Loc),
Expression =>
- Make_Op_Subtract (Loc,
+ Make_Op_Add (Loc,
Left_Opnd =>
Unchecked_Convert_To
(RTE (RE_Storage_Offset),
@@ -4234,14 +4234,15 @@
else
Append_To (DT_Aggr_List,
- Make_Attribute_Reference (Loc,
- Prefix =>
- Make_Selected_Component (Loc,
- Prefix =>
- New_Occurrence_Of (Dummy_Object, Loc),
- Selector_Name =>
- New_Occurrence_Of (Iface_Comp, Loc)),
- Attribute_Name => Name_Position));
+ Make_Op_Minus (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Selected_Component (Loc,
+ Prefix =>
+ New_Occurrence_Of (Dummy_Object, Loc),
+ Selector_Name =>
+ New_Occurrence_Of (Iface_Comp, Loc)),
+ Attribute_Name => Name_Position)));
end if;
-- Generate the Object Specific Data table required to dispatch calls
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb (revision 254563)
+++ exp_ch3.adb (working copy)
@@ -2176,7 +2176,7 @@
-- Generate
-- function Fxx (O : in Rec_Typ) return Storage_Offset is
-- begin
- -- return O.Iface_Comp'Position;
+ -- return -O.Iface_Comp'Position;
-- end Fxx;
Body_Node := New_Node (N_Subprogram_Body, Loc);
@@ -2199,15 +2199,16 @@
Statements => New_List (
Make_Simple_Return_Statement (Loc,
Expression =>
- Make_Attribute_Reference (Loc,
- Prefix =>
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (Acc_Type,
- Make_Identifier (Loc, Name_uO)),
- Selector_Name =>
- New_Occurrence_Of (Iface_Comp, Loc)),
- Attribute_Name => Name_Position)))));
+ Make_Op_Minus (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Selected_Component (Loc,
+ Prefix =>
+ Unchecked_Convert_To (Acc_Type,
+ Make_Identifier (Loc, Name_uO)),
+ Selector_Name =>
+ New_Occurrence_Of (Iface_Comp, Loc)),
+ Attribute_Name => Name_Position))))));
Set_Ekind (Func_Id, E_Function);
Set_Mechanism (Func_Id, Default_Mechanism);
@@ -8516,13 +8517,14 @@
Unchecked_Convert_To
(RTE (RE_Storage_Offset),
- Make_Attribute_Reference (Loc,
- Prefix =>
- Make_Selected_Component (Loc,
- Prefix => New_Copy_Tree (Target),
- Selector_Name =>
- New_Occurrence_Of (Tag_Comp, Loc)),
- Attribute_Name => Name_Position)),
+ Make_Op_Minus (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Copy_Tree (Target),
+ Selector_Name =>
+ New_Occurrence_Of (Tag_Comp, Loc)),
+ Attribute_Name => Name_Position))),
Unchecked_Convert_To (RTE (RE_Offset_To_Top_Function_Ptr),
Make_Attribute_Reference (Loc,
@@ -8545,12 +8547,13 @@
New_Occurrence_Of (Offset_To_Top_Comp, Loc)),
Expression =>
- Make_Attribute_Reference (Loc,
- Prefix =>
- Make_Selected_Component (Loc,
- Prefix => New_Copy_Tree (Target),
- Selector_Name => New_Occurrence_Of (Tag_Comp, Loc)),
- Attribute_Name => Name_Position)));
+ Make_Op_Minus (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Copy_Tree (Target),
+ Selector_Name => New_Occurrence_Of (Tag_Comp, Loc)),
+ Attribute_Name => Name_Position))));
-- Normal case: No discriminants in the parent type
@@ -8567,13 +8570,14 @@
Iface_Tag => New_Occurrence_Of (Iface_Tag, Loc),
Offset_Value =>
Unchecked_Convert_To (RTE (RE_Storage_Offset),
- Make_Attribute_Reference (Loc,
- Prefix =>
- Make_Selected_Component (Loc,
- Prefix => New_Copy_Tree (Target),
- Selector_Name =>
- New_Occurrence_Of (Tag_Comp, Loc)),
- Attribute_Name => Name_Position))));
+ Make_Op_Minus (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Copy_Tree (Target),
+ Selector_Name =>
+ New_Occurrence_Of (Tag_Comp, Loc)),
+ Attribute_Name => Name_Position)))));
end if;
-- Generate:
@@ -8602,13 +8606,14 @@
New_Occurrence_Of (Standard_True, Loc),
Unchecked_Convert_To (RTE (RE_Storage_Offset),
- Make_Attribute_Reference (Loc,
- Prefix =>
- Make_Selected_Component (Loc,
- Prefix => New_Copy_Tree (Target),
- Selector_Name =>
- New_Occurrence_Of (Tag_Comp, Loc)),
- Attribute_Name => Name_Position)),
+ Make_Op_Minus (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Copy_Tree (Target),
+ Selector_Name =>
+ New_Occurrence_Of (Tag_Comp, Loc)),
+ Attribute_Name => Name_Position))),
Make_Null (Loc))));
end if;
@@ -8712,15 +8717,10 @@
-- Initialize secondary tags
else
- Append_To (Init_Tags_List,
- Make_Assignment_Statement (Loc,
- Name =>
- Make_Selected_Component (Loc,
- Prefix => New_Copy_Tree (Target),
- Selector_Name =>
- New_Occurrence_Of (Node (Iface_Comp_Elmt), Loc)),
- Expression =>
- New_Occurrence_Of (Node (Iface_Tag_Elmt), Loc)));
+ Initialize_Tag (Full_Typ,
+ Iface => Node (Iface_Elmt),
+ Tag_Comp => Tag_Comp,
+ Iface_Tag => Node (Iface_Tag_Elmt));
end if;
-- Otherwise generate code to initialize the tag
