decl.c (Has_Thiscall_Convention): New macro.
2012-05-19 Eric Botcazou <ebotcazou@adacore.com> * gcc-interface/decl.c (Has_Thiscall_Convention): New macro. (gnat_to_gnu_entity) <E_Subprogram_Type>: Test it to set the thiscall calling convention (get_minimal_subprog_decl): Likewise. (gnat_first_param_is_class): New predicate. Backport from mainline 2012-05-15 Javier Miranda <miranda@adacore.com> * exp_ch3.adb (Build_Offset_To_Top): Modify the expansion of the offset_to_top functions to ensure that their profile is conformant with the profile specified in Ada.Tags. No change in functionality. From-SVN: r187677
This commit is contained in:
Eric Botcazou
Eric Botcazou
parent
46dc2b6e2e
commit
450f261efe
|
|
@ -1,3 +1,19 @@
|
|||
2012-05-19 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/decl.c (Has_Thiscall_Convention): New macro.
|
||||
(gnat_to_gnu_entity) <E_Subprogram_Type>: Test it to set the thiscall
|
||||
calling convention
|
||||
(get_minimal_subprog_decl): Likewise.
|
||||
(gnat_first_param_is_class): New predicate.
|
||||
|
||||
Backport from mainline
|
||||
2012-05-15 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* exp_ch3.adb (Build_Offset_To_Top): Modify the
|
||||
expansion of the offset_to_top functions to ensure that their
|
||||
profile is conformant with the profile specified in Ada.Tags. No
|
||||
change in functionality.
|
||||
|
||||
2012-05-18 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: For an object at
|
||||
|
|
|
|||
|
|
@ -1883,9 +1883,10 @@ package body Exp_Ch3 is
|
|||
|
||||
procedure Build_Offset_To_Top_Function (Iface_Comp : Entity_Id);
|
||||
-- Generate:
|
||||
-- function Fxx (O : in Rec_Typ) return Storage_Offset is
|
||||
-- function Fxx (O : Address) return Storage_Offset is
|
||||
-- type Acc is access all <Typ>;
|
||||
-- begin
|
||||
-- return O.Iface_Comp'Position;
|
||||
-- return Acc!(O).Iface_Comp'Position;
|
||||
-- end Fxx;
|
||||
|
||||
----------------------------------
|
||||
|
|
@ -1896,6 +1897,7 @@ package body Exp_Ch3 is
|
|||
Body_Node : Node_Id;
|
||||
Func_Id : Entity_Id;
|
||||
Spec_Node : Node_Id;
|
||||
Acc_Type : Entity_Id;
|
||||
|
||||
begin
|
||||
Func_Id := Make_Temporary (Loc, 'F');
|
||||
|
|
@ -1912,7 +1914,7 @@ package body Exp_Ch3 is
|
|||
Make_Defining_Identifier (Loc, Name_uO),
|
||||
In_Present => True,
|
||||
Parameter_Type =>
|
||||
New_Reference_To (Rec_Type, Loc))));
|
||||
New_Reference_To (RTE (RE_Address), Loc))));
|
||||
Set_Result_Definition (Spec_Node,
|
||||
New_Reference_To (RTE (RE_Storage_Offset), Loc));
|
||||
|
||||
|
|
@ -1924,7 +1926,19 @@ package body Exp_Ch3 is
|
|||
|
||||
Body_Node := New_Node (N_Subprogram_Body, Loc);
|
||||
Set_Specification (Body_Node, Spec_Node);
|
||||
Set_Declarations (Body_Node, New_List);
|
||||
|
||||
Acc_Type := Make_Temporary (Loc, 'T');
|
||||
Set_Declarations (Body_Node, New_List (
|
||||
Make_Full_Type_Declaration (Loc,
|
||||
Defining_Identifier => Acc_Type,
|
||||
Type_Definition =>
|
||||
Make_Access_To_Object_Definition (Loc,
|
||||
All_Present => True,
|
||||
Null_Exclusion_Present => False,
|
||||
Constant_Present => False,
|
||||
Subtype_Indication =>
|
||||
New_Reference_To (Rec_Type, Loc)))));
|
||||
|
||||
Set_Handled_Statement_Sequence (Body_Node,
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => New_List (
|
||||
|
|
@ -1933,7 +1947,9 @@ package body Exp_Ch3 is
|
|||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
Make_Selected_Component (Loc,
|
||||
Prefix => Make_Identifier (Loc, Name_uO),
|
||||
Prefix =>
|
||||
Unchecked_Convert_To (Acc_Type,
|
||||
Make_Identifier (Loc, Name_uO)),
|
||||
Selector_Name =>
|
||||
New_Reference_To (Iface_Comp, Loc)),
|
||||
Attribute_Name => Name_Position)))));
|
||||
|
|
|
|||
|
|
@ -50,19 +50,23 @@
|
|||
#include "ada-tree.h"
|
||||
#include "gigi.h"
|
||||
|
||||
/* Convention_Stdcall should be processed in a specific way on 32 bits
|
||||
Windows targets only. The macro below is a helper to avoid having to
|
||||
check for a Windows specific attribute throughout this unit. */
|
||||
/* "stdcall" and "thiscall" conventions should be processed in a specific way
|
||||
on 32-bit x86/Windows only. The macros below are helpers to avoid having
|
||||
to check for a Windows specific attribute throughout this unit. */
|
||||
|
||||
#if TARGET_DLLIMPORT_DECL_ATTRIBUTES
|
||||
#ifdef TARGET_64BIT
|
||||
#define Has_Stdcall_Convention(E) \
|
||||
(!TARGET_64BIT && Convention (E) == Convention_Stdcall)
|
||||
#define Has_Thiscall_Convention(E) \
|
||||
(!TARGET_64BIT && gnat_first_param_is_class (E))
|
||||
#else
|
||||
#define Has_Stdcall_Convention(E) (Convention (E) == Convention_Stdcall)
|
||||
#define Has_Thiscall_Convention(E) (gnat_first_param_is_class (E))
|
||||
#endif
|
||||
#else
|
||||
#define Has_Stdcall_Convention(E) 0
|
||||
#define Has_Thiscall_Convention(E) 0
|
||||
#endif
|
||||
|
||||
/* Stack realignment is necessary for functions with foreign conventions when
|
||||
|
|
@ -140,6 +144,7 @@ enum alias_set_op
|
|||
|
||||
static void relate_alias_sets (tree, tree, enum alias_set_op);
|
||||
|
||||
static bool gnat_first_param_is_class (Entity_Id) ATTRIBUTE_UNUSED;
|
||||
static bool allocatable_size_p (tree, bool);
|
||||
static void prepend_one_attribute_to (struct attrib **,
|
||||
enum attr_type, tree, tree, Node_Id);
|
||||
|
|
@ -4410,6 +4415,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
(&attr_list, ATTR_MACHINE_ATTRIBUTE,
|
||||
get_identifier ("stdcall"), NULL_TREE,
|
||||
gnat_entity);
|
||||
else if (Has_Thiscall_Convention (gnat_entity))
|
||||
prepend_one_attribute_to
|
||||
(&attr_list, ATTR_MACHINE_ATTRIBUTE,
|
||||
get_identifier ("thiscall"), NULL_TREE,
|
||||
gnat_entity);
|
||||
|
||||
/* If we should request stack realignment for a foreign convention
|
||||
subprogram, do so. Note that this applies to task entry points in
|
||||
|
|
@ -5290,6 +5300,10 @@ get_minimal_subprog_decl (Entity_Id gnat_entity)
|
|||
prepend_one_attribute_to (&attr_list, ATTR_MACHINE_ATTRIBUTE,
|
||||
get_identifier ("stdcall"), NULL_TREE,
|
||||
gnat_entity);
|
||||
else if (Has_Thiscall_Convention (gnat_entity))
|
||||
prepend_one_attribute_to (&attr_list, ATTR_MACHINE_ATTRIBUTE,
|
||||
get_identifier ("thiscall"), NULL_TREE,
|
||||
gnat_entity);
|
||||
|
||||
if (No (Interface_Name (gnat_entity)) && gnu_ext_name == gnu_entity_name)
|
||||
gnu_ext_name = NULL_TREE;
|
||||
|
|
@ -5338,6 +5352,63 @@ rest_of_type_decl_compilation_no_defer (tree decl)
|
|||
}
|
||||
}
|
||||
|
||||
/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY has
|
||||
a first parameter with a class or equivalent type.
|
||||
|
||||
We use the predicate on 32-bit x86/Windows to find out whether we need to
|
||||
use the "thiscall" calling convention for GNAT_ENTITY. This convention is
|
||||
the one set for C++ methods (functions with METHOD_TYPE) by the back-end.
|
||||
Now in Ada primitive operations are regular subprograms (e.g. you can have
|
||||
common pointers to both) so we cannot compute an equivalent of METHOD_TYPE
|
||||
and so we set the calling convention in an uniform way. */
|
||||
|
||||
static bool
|
||||
gnat_first_param_is_class (Entity_Id gnat_entity)
|
||||
{
|
||||
Entity_Id gnat_param = First_Formal_With_Extras (gnat_entity);
|
||||
Entity_Id gnat_type;
|
||||
Node_Id node;
|
||||
|
||||
if (No (gnat_param))
|
||||
return false;
|
||||
|
||||
gnat_type = Underlying_Type (Etype (gnat_param));
|
||||
|
||||
/* This is the main case. Note that we must return the same value for
|
||||
regular tagged types and CW types since dispatching calls have a CW
|
||||
type on the caller side and a tagged type on the callee side. */
|
||||
if (Is_Tagged_Type (gnat_type))
|
||||
return True;
|
||||
|
||||
/* C++ classes with no virtual functions can be imported as limited
|
||||
record types, but we need to return true for the constructors. */
|
||||
if (Is_CPP_Class (gnat_type))
|
||||
return True;
|
||||
|
||||
/* The language-level "protected" calling convention doesn't distinguish
|
||||
tagged protected types from non-tagged protected types (e.g. you can
|
||||
have common pointers to both) so we must use a single low-level calling
|
||||
convention for it. Since tagged protected types can be derived from
|
||||
simple limited interfaces, we need to pick the calling convention of
|
||||
the latters. */
|
||||
if (Is_Protected_Record_Type (gnat_type))
|
||||
return True;
|
||||
|
||||
/* If this is the special E_Subprogram_Type built for the declaration of
|
||||
an access to protected subprogram type, the first parameter will have
|
||||
type Address, but we must return true to be consistent with above. */
|
||||
if (Is_Itype (gnat_entity)
|
||||
&& Present (node = Associated_Node_For_Itype (gnat_entity))
|
||||
&& Nkind (node) == N_Full_Type_Declaration
|
||||
&& Ekind (Defining_Identifier (node)) == E_Access_Subprogram_Type
|
||||
&& Present (node = Original_Access_Type (Defining_Identifier (node)))
|
||||
&& (Ekind (node) == E_Access_Protected_Subprogram_Type
|
||||
|| Ekind (node) == E_Anonymous_Access_Protected_Subprogram_Type))
|
||||
return True;
|
||||
|
||||
return False;
|
||||
}
|
||||
|
||||
/* Finalize the processing of From_With_Type incomplete types. */
|
||||
|
||||
void
|
||||
|
|
|
|||
Loading…
Reference in New Issue