+2010-10-10 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/ada-tree.h (DECL_BY_DOUBLE_REF_P): New macro.
+ * gcc-interface/gigi.h (annotate_object): Add BY_DOUBLE_REF parameter.
+ * gcc-interface/decl.c (annotate_object): Likewise and handle it.
+ (gnat_to_gnu_entity): Adjust calls to annotate_object.
+ (gnat_to_gnu_param): If fat pointer types are passed by reference on
+ the target, pass them by explicit reference.
+ * gcc-interface/misc.c (default_pass_by_ref): Fix type of constant.
+ * gcc-interface/trans.c (Identifier_to_gnu): Do DECL_BY_DOUBLE_REF_P.
+ (Subprogram_Body_to_gnu): Adjust call to annotate_object.
+ (call_to_gnu): Handle DECL_BY_DOUBLE_REF_P.
+ * gcc-interface/utils.c (convert_vms_descriptor): Add BY_REF parameter
+ and handle it.
+ (build_function_stub): Iterate on the parameters of the subprogram in
+ lieu of on the argument types. Adjust call to convert_vms_descriptor.
+
2010-10-09 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/misc.c: Delete prototypes.
constant CONSTRUCTOR. */
#define DECL_CONST_ADDRESS_P(NODE) DECL_LANG_FLAG_0 (CONST_DECL_CHECK (NODE))
-/* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF
+/* Nonzero in a PARM_DECL if it is always used by double reference, i.e. a
+ pair of INDIRECT_REFs is needed to access the object. */
+#define DECL_BY_DOUBLE_REF_P(NODE) DECL_LANG_FLAG_0 (PARM_DECL_CHECK (NODE))
+
+/* Nonzero in a DECL if it is always used by reference, i.e. an INDIRECT_REF
is needed to access the object. */
#define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE)
/* Nonzero in a FIELD_DECL that is a dummy built for some internal reason. */
#define DECL_INTERNAL_P(NODE) DECL_LANG_FLAG_3 (FIELD_DECL_CHECK (NODE))
-/* Nonzero if this decl is a PARM_DECL for an Ada array being passed to a
+/* Nonzero in a PARM_DECL if it is made for an Ada array being passed to a
foreign convention subprogram. */
#define DECL_BY_COMPONENT_PTR_P(NODE) DECL_LANG_FLAG_3 (PARM_DECL_CHECK (NODE))
#define DECL_ELABORATION_PROC_P(NODE) \
DECL_LANG_FLAG_3 (FUNCTION_DECL_CHECK (NODE))
-/* Nonzero if this is a decl for a pointer that points to something which
+/* Nonzero in a DECL if it is made for a pointer that points to something which
is readonly. Used mostly for fat pointers. */
#define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (NODE)
save_gnu_tree (gnat_entity, gnu_decl, true);
saved = true;
annotate_object (gnat_entity, gnu_type, NULL_TREE,
- false);
+ false, false);
break;
}
type of the object and not on the object directly, and makes it
possible to support all confirming representation clauses. */
annotate_object (gnat_entity, TREE_TYPE (gnu_decl), gnu_object_size,
- used_by_ref);
+ used_by_ref, false);
}
break;
bool in_param = (Ekind (gnat_param) == E_In_Parameter);
/* The parameter can be indirectly modified if its address is taken. */
bool ro_param = in_param && !Address_Taken (gnat_param);
- bool by_return = false, by_component_ptr = false, by_ref = false;
+ bool by_return = false, by_component_ptr = false;
+ bool by_ref = false, by_double_ref = false;
tree gnu_param;
/* Copy-return is used only for the first parameter of a valued procedure.
{
gnu_param_type = build_reference_type (gnu_param_type);
by_ref = true;
+
+ /* In some ABIs, e.g. SPARC 32-bit, fat pointer types are themselves
+ passed by reference. Pass them by explicit reference, this will
+ generate more debuggable code at -O0. */
+ if (TYPE_IS_FAT_POINTER_P (gnu_param_type)
+ && targetm.calls.pass_by_reference (NULL,
+ TYPE_MODE (gnu_param_type),
+ gnu_param_type,
+ true))
+ {
+ gnu_param_type = build_reference_type (gnu_param_type);
+ by_double_ref = true;
+ }
}
/* Pass In Out or Out parameters using copy-in copy-out mechanism. */
gnu_param = create_param_decl (gnu_param_name, gnu_param_type,
ro_param || by_ref || by_component_ptr);
DECL_BY_REF_P (gnu_param) = by_ref;
+ DECL_BY_DOUBLE_REF_P (gnu_param) = by_double_ref;
DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor ||
mech == By_Short_Descriptor);
/* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
size and alignment used by Gigi. Prefer SIZE over TYPE_SIZE if non-null.
- BY_REF is true if the object is used by reference. */
+ BY_REF is true if the object is used by reference and BY_DOUBLE_REF is
+ true if the object is used by double reference. */
void
-annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref)
+annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref,
+ bool by_double_ref)
{
if (by_ref)
{
+ if (by_double_ref)
+ gnu_type = TREE_TYPE (gnu_type);
+
if (TYPE_IS_FAT_POINTER_P (gnu_type))
gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type);
else
/* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
size and alignment used by Gigi. Prefer SIZE over TYPE_SIZE if non-null.
- BY_REF is true if the object is used by reference. */
+ BY_REF is true if the object is used by reference and BY_DOUBLE_REF is
+ true if the object is used by double reference. */
extern void annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size,
- bool by_ref);
+ bool by_ref, bool by_double_ref);
/* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
type with all size expressions that contain F updated by replacing F
*highval = TYPE_MAX_VALUE (gnu_type);
}
-/* GNU_TYPE is a type. Determine if it should be passed by reference by
- default. */
+/* GNU_TYPE is the type of a subprogram parameter. Determine if it should be
+ passed by reference by default. */
bool
default_pass_by_ref (tree gnu_type)
is an In Out parameter, but it's probably best to err on the side of
passing more things by reference. */
- if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, 1))
+ if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true))
return true;
if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
return false;
}
-/* GNU_TYPE is the type of a subprogram parameter. Determine from the type if
- it should be passed by reference. */
+/* GNU_TYPE is the type of a subprogram parameter. Determine if it must be
+ passed by reference. */
bool
must_pass_by_ref (tree gnu_type)
tree renamed_obj;
if (TREE_CODE (gnu_result) == PARM_DECL
+ && DECL_BY_DOUBLE_REF_P (gnu_result))
+ gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
+
+ if (TREE_CODE (gnu_result) == PARM_DECL
&& DECL_BY_COMPONENT_PTR_P (gnu_result))
gnu_result
= build_unary_op (INDIRECT_REF, NULL_TREE,
gnat_param = Next_Formal_With_Extras (gnat_param))
{
tree gnu_param = get_gnu_tree (gnat_param);
+ bool is_var_decl = (TREE_CODE (gnu_param) == VAR_DECL);
+
annotate_object (gnat_param, TREE_TYPE (gnu_param), NULL_TREE,
- DECL_BY_REF_P (gnu_param));
- if (TREE_CODE (gnu_param) == VAR_DECL)
+ DECL_BY_REF_P (gnu_param),
+ !is_var_decl && DECL_BY_DOUBLE_REF_P (gnu_param));
+
+ if (is_var_decl)
save_gnu_tree (gnat_param, NULL_TREE, false);
}
/* The symmetry of the paths to the type of an entity is broken here
since arguments don't know that they will be passed by ref. */
gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
+
+ if (DECL_BY_DOUBLE_REF_P (gnu_formal))
+ gnu_actual
+ = build_unary_op (ADDR_EXPR, TREE_TYPE (gnu_formal_type),
+ gnu_actual);
+
gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual);
}
else if (gnu_formal
/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a regular
pointer or fat pointer type. GNU_EXPR_ALT_TYPE is the alternate (32-bit)
- pointer type of GNU_EXPR. GNAT_SUBPROG is the subprogram to which the
- VMS descriptor is passed. */
+ pointer type of GNU_EXPR. BY_REF is true if the result is to be used by
+ reference. GNAT_SUBPROG is the subprogram to which the VMS descriptor is
+ passed. */
static tree
convert_vms_descriptor (tree gnu_type, tree gnu_expr, tree gnu_expr_alt_type,
- Entity_Id gnat_subprog)
+ bool by_ref, Entity_Id gnat_subprog)
{
tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
tree mbo = TYPE_FIELDS (desc_type);
const char *mbostr = IDENTIFIER_POINTER (DECL_NAME (mbo));
tree mbmo = DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (mbo)));
- tree is64bit, gnu_expr32, gnu_expr64;
+ tree real_type, is64bit, gnu_expr32, gnu_expr64;
+
+ if (by_ref)
+ real_type = TREE_TYPE (gnu_type);
+ else
+ real_type = gnu_type;
/* If the field name is not MBO, it must be 32-bit and no alternate.
Otherwise primary must be 64-bit and alternate 32-bit. */
if (strcmp (mbostr, "MBO") != 0)
- return convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
+ {
+ tree ret = convert_vms_descriptor32 (real_type, gnu_expr, gnat_subprog);
+ if (by_ref)
+ ret = build_unary_op (ADDR_EXPR, gnu_type, ret);
+ return ret;
+ }
/* Build the test for 64-bit descriptor. */
mbo = build3 (COMPONENT_REF, TREE_TYPE (mbo), desc, mbo, NULL_TREE);
integer_minus_one_node));
/* Build the 2 possible end results. */
- gnu_expr64 = convert_vms_descriptor64 (gnu_type, gnu_expr, gnat_subprog);
+ gnu_expr64 = convert_vms_descriptor64 (real_type, gnu_expr, gnat_subprog);
+ if (by_ref)
+ gnu_expr64 = build_unary_op (ADDR_EXPR, gnu_type, gnu_expr64);
gnu_expr = fold_convert (gnu_expr_alt_type, gnu_expr);
- gnu_expr32 = convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
+ gnu_expr32 = convert_vms_descriptor32 (real_type, gnu_expr, gnat_subprog);
+ if (by_ref)
+ gnu_expr32 = build_unary_op (ADDR_EXPR, gnu_type, gnu_expr32);
return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
}
build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
{
tree gnu_subprog_type, gnu_subprog_addr, gnu_subprog_call;
- tree gnu_stub_param, gnu_arg_types, gnu_param;
+ tree gnu_subprog_param, gnu_stub_param, gnu_param;
tree gnu_stub_decl = DECL_FUNCTION_STUB (gnu_subprog);
VEC(tree,gc) *gnu_param_vec = NULL;
/* Loop over the parameters of the stub and translate any of them
passed by descriptor into a by reference one. */
for (gnu_stub_param = DECL_ARGUMENTS (gnu_stub_decl),
- gnu_arg_types = TYPE_ARG_TYPES (gnu_subprog_type);
+ gnu_subprog_param = DECL_ARGUMENTS (gnu_subprog);
gnu_stub_param;
gnu_stub_param = TREE_CHAIN (gnu_stub_param),
- gnu_arg_types = TREE_CHAIN (gnu_arg_types))
+ gnu_subprog_param = TREE_CHAIN (gnu_subprog_param))
{
if (DECL_BY_DESCRIPTOR_P (gnu_stub_param))
- gnu_param
- = convert_vms_descriptor (TREE_VALUE (gnu_arg_types),
- gnu_stub_param,
- DECL_PARM_ALT_TYPE (gnu_stub_param),
- gnat_subprog);
+ {
+ gcc_assert (DECL_BY_REF_P (gnu_subprog_param));
+ gnu_param
+ = convert_vms_descriptor (TREE_TYPE (gnu_subprog_param),
+ gnu_stub_param,
+ DECL_PARM_ALT_TYPE (gnu_stub_param),
+ DECL_BY_DOUBLE_REF_P (gnu_subprog_param),
+ gnat_subprog);
+ }
else
gnu_param = gnu_stub_param;
OSDN Git Service
