#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 && is_cplusplus_method (E))
#else
#define Has_Stdcall_Convention(E) (Convention (E) == Convention_Stdcall)
+#define Has_Thiscall_Convention(E) (is_cplusplus_method (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
/* 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 bool cannot_be_superflat_p (Node_Id);
static bool constructor_address_p (tree);
static void components_to_record (tree, Node_Id, tree, int, bool, bool, bool,
- bool, bool, bool, bool, tree, tree *);
+ bool, bool, bool, bool, bool, tree, tree *);
static Uint annotate_value (tree);
static void annotate_rep (Entity_Id, tree);
static tree build_position_list (tree, bool, tree, tree, unsigned int, tree);
gnu_size = max_size (TYPE_SIZE (gnu_type), true);
mutable_p = true;
}
+
+ /* If we are at global level and the size isn't constant, call
+ elaborate_expression_1 to make a variable for it rather than
+ calculating it each time. */
+ if (global_bindings_p () && !TREE_CONSTANT (gnu_size))
+ gnu_size = elaborate_expression_1 (gnu_size, gnat_entity,
+ get_identifier ("SIZE"),
+ definition, false);
}
/* If the size is zero byte, make it one byte since some linkers have
const bool convention_fortran_p
= (Convention (gnat_entity) == Convention_Fortran);
const int ndim = Number_Dimensions (gnat_entity);
- tree gnu_template_type = make_node (RECORD_TYPE);
- tree gnu_ptr_template = build_pointer_type (gnu_template_type);
+ tree gnu_template_type;
+ tree gnu_ptr_template;
tree gnu_template_reference, gnu_template_fields, gnu_fat_type;
tree *gnu_index_types = XALLOCAVEC (tree, ndim);
tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
TYPE_NAME (gnu_fat_type) = NULL_TREE;
/* Save the contents of the dummy type for update_pointer_to. */
TYPE_POINTER_TO (gnu_type) = copy_type (gnu_fat_type);
+ gnu_ptr_template =
+ TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)));
+ gnu_template_type = TREE_TYPE (gnu_ptr_template);
}
else
- gnu_fat_type = make_node (RECORD_TYPE);
+ {
+ gnu_fat_type = make_node (RECORD_TYPE);
+ gnu_template_type = make_node (RECORD_TYPE);
+ gnu_ptr_template = build_pointer_type (gnu_template_type);
+ }
/* Make a node for the array. If we are not defining the array
suppress expanding incomplete types. */
/* Add the fields into the record type and finish it up. */
components_to_record (gnu_type, Component_List (record_definition),
gnu_field_list, packed, definition, false,
- all_rep, is_unchecked_union, debug_info_p,
+ all_rep, is_unchecked_union,
+ !Comes_From_Source (gnat_entity), debug_info_p,
false, OK_To_Reorder_Components (gnat_entity),
all_rep ? NULL_TREE : bitsize_zero_node, NULL);
else
gnu_unpad_base_type = gnu_base_type;
- /* Look for a REP part in the base type. */
- gnu_rep_part = get_rep_part (gnu_unpad_base_type);
-
/* Look for a variant part in the base type. */
gnu_variant_part = get_variant_part (gnu_unpad_base_type);
{
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
and put the field either in the new type if there is a
selected variant or in one of the new variants. */
if (gnu_context == gnu_unpad_base_type
- || (gnu_rep_part
+ || ((gnu_rep_part = get_rep_part (gnu_unpad_base_type))
&& gnu_context == TREE_TYPE (gnu_rep_part)))
gnu_cont_type = gnu_type;
else
t = NULL_TREE;
FOR_EACH_VEC_ELT_REVERSE (variant_desc,
gnu_variant_list, ix, v)
- if (v->type == gnu_context)
+ if (gnu_context == v->type
+ || ((gnu_rep_part = get_rep_part (v->type))
+ && gnu_context == TREE_TYPE (gnu_rep_part)))
{
t = v->type;
break;
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
(&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
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;
}
}
+/* 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
+ used for C++ methods (functions with METHOD_TYPE) by the back-end. */
+
+bool
+is_cplusplus_method (Entity_Id gnat_entity)
+{
+ if (Convention (gnat_entity) != Convention_CPP)
+ return False;
+
+ /* This is the main case: C++ method imported as a primitive operation. */
+ if (Is_Dispatching_Operation (gnat_entity))
+ return True;
+
+ /* 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_Constructor (gnat_entity))
+ return True;
+
+ /* This is set on the E_Subprogram_Type built for a dispatching call. */
+ if (Is_Dispatch_Table_Entity (gnat_entity))
+ return True;
+
+ return False;
+}
+
/* Finalize the processing of From_With_Type incomplete types. */
void
UNCHECKED_UNION is true if we are building this type for a record with a
Pragma Unchecked_Union.
+ ARTIFICIAL is true if this is a type that was generated by the compiler.
+
DEBUG_INFO is true if we need to write debug information about the type.
MAYBE_UNUSED is true if this type may be unused in the end; this doesn't
components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
tree gnu_field_list, int packed, bool definition,
bool cancel_alignment, bool all_rep,
- bool unchecked_union, bool debug_info,
- bool maybe_unused, bool reorder,
+ bool unchecked_union, bool artificial,
+ bool debug_info, bool maybe_unused, bool reorder,
tree first_free_pos, tree *p_gnu_rep_list)
{
bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
components_to_record (gnu_variant_type, Component_List (variant),
NULL_TREE, packed, definition,
!all_rep_and_size, all_rep, unchecked_union,
- debug_info, true, reorder, this_first_free_pos,
+ true, debug_info, true, reorder,
+ this_first_free_pos,
all_rep || this_first_free_pos
? NULL : &gnu_rep_list);
TYPE_ALIGN (gnu_record_type) = 0;
finish_record_type (gnu_record_type, nreverse (gnu_field_list),
- layout_with_rep ? 1 : 0, debug_info && !maybe_unused);
+ layout_with_rep ? 1 : 0, false);
+ TYPE_ARTIFICIAL (gnu_record_type) = artificial;
+ if (debug_info && !maybe_unused)
+ rest_of_record_type_compilation (gnu_record_type);
}
\f
/* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be
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);
/* The REP part is the first field, internal, another record, and its name
starts with an 'R'. */
- if (DECL_INTERNAL_P (field)
+ if (field
+ && DECL_INTERNAL_P (field)
&& TREE_CODE (TREE_TYPE (field)) == RECORD_TYPE
&& IDENTIFIER_POINTER (DECL_NAME (field)) [0] == 'R')
return field;
/* 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
