#define Has_Stdcall_Convention(E) \
(!TARGET_64BIT && Convention (E) == Convention_Stdcall)
#define Has_Thiscall_Convention(E) \
- (!TARGET_64BIT && gnat_first_param_is_class (E))
+ (!TARGET_64BIT && is_cplusplus_method (E))
#else
#define Has_Stdcall_Convention(E) (Convention (E) == Convention_Stdcall)
-#define Has_Thiscall_Convention(E) (gnat_first_param_is_class (E))
+#define Has_Thiscall_Convention(E) (is_cplusplus_method (E))
#endif
#else
#define Has_Stdcall_Convention(E) 0
/* The value of the qualifier. */
tree qual;
- /* The record associated with this variant. */
- tree record;
+ /* The type of the variant after transformation. */
+ tree new_type;
} variant_desc;
DEF_VEC_O(variant_desc);
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);
{
tree old_variant = v->type;
tree new_variant = make_node (RECORD_TYPE);
+ tree suffix
+ = concat_name (DECL_NAME (gnu_variant_part),
+ IDENTIFIER_POINTER
+ (DECL_NAME (v->field)));
TYPE_NAME (new_variant)
- = DECL_NAME (TYPE_NAME (old_variant));
+ = concat_name (TYPE_NAME (gnu_type),
+ IDENTIFIER_POINTER (suffix));
copy_and_substitute_in_size (new_variant, old_variant,
gnu_subst_list);
- v->record = new_variant;
+ v->new_type = new_variant;
}
}
else
if (selected_variant)
gnu_cont_type = gnu_type;
else
- gnu_cont_type = v->record;
+ gnu_cont_type = v->new_type;
}
else
/* The front-end may pass us "ghost" components if
}
}
-/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY has
- a first parameter with a class or equivalent type.
+/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
+ a C++ imported method or equivalent.
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. */
+ used for C++ methods (functions with METHOD_TYPE) by the back-end. */
-static bool
-gnat_first_param_is_class (Entity_Id gnat_entity)
+bool
+is_cplusplus_method (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;
+ if (Convention (gnat_entity) != Convention_CPP)
+ return False;
- gnat_type = Underlying_Type (Etype (gnat_param));
+ /* This is the main case: C++ method imported as a primitive operation. */
+ if (Is_Dispatching_Operation (gnat_entity))
+ return True;
- /* 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))
+ /* A thunk needs to be handled like its associated primitive operation. */
+ if (Is_Subprogram (gnat_entity) && Is_Thunk (gnat_entity))
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))
+ if (Is_Constructor (gnat_entity))
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))
+ /* This is set on the E_Subprogram_Type built for a dispatching call. */
+ if (Is_Dispatch_Table_Entity (gnat_entity))
return True;
return False;
v->type = variant_type;
v->field = gnu_field;
v->qual = qual;
- v->record = NULL_TREE;
+ v->new_type = NULL_TREE;
/* Recurse on the variant subpart of the variant, if any. */
variant_subpart = get_variant_part (variant_type);
/* First create the type of the variant part from that of the old one. */
new_union_type = make_node (QUAL_UNION_TYPE);
- TYPE_NAME (new_union_type) = DECL_NAME (TYPE_NAME (old_union_type));
+ TYPE_NAME (new_union_type)
+ = concat_name (TYPE_NAME (record_type),
+ IDENTIFIER_POINTER (DECL_NAME (old_variant_part)));
/* If the position of the variant part is constant, subtract it from the
size of the type of the parent to get the new size. This manual CSE
continue;
/* Retrieve the list of fields already added to the new variant. */
- new_variant = v->record;
+ new_variant = v->new_type;
field_list = TYPE_FIELDS (new_variant);
/* If the old variant had a variant subpart, we need to create a new
OSDN Git Service
