ada-tree.h (DECL_PARM_ALT): Now DECL_PARM_ALT_TYPE.

* gcc-interface/ada-tree.h (DECL_PARM_ALT): Now DECL_PARM_ALT_TYPE.
	* gcc-interface/decl.c (gnat_to_gnu_param): Fix formatting, simplify
	and adjust for above renaming.
	* gcc-interface/utils.c (convert_vms_descriptor): Likewise. Add new
	gnu_expr_alt_type parameter.  Convert the expression to it instead
	of changing its type in place.
	(build_function_stub): Adjust call to above function.

From-SVN: r138518
This commit is contained in:
Eric Botcazou 2008-08-01 14:02:10 +00:00 committed by Eric Botcazou
parent de1132d194
commit a981c96402
4 changed files with 49 additions and 48 deletions

View File

@ -1,3 +1,13 @@
2008-08-01 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/ada-tree.h (DECL_PARM_ALT): Now DECL_PARM_ALT_TYPE.
* gcc-interface/decl.c (gnat_to_gnu_param): Fix formatting, simplify
and adjust for above renaming.
* gcc-interface/utils.c (convert_vms_descriptor): Likewise. Add new
gnu_expr_alt_type parameter. Convert the expression to it instead
of changing its type in place.
(build_function_stub): Adjust call to above function.
2008-08-01 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Constant>: Remove dead

View File

@ -294,10 +294,10 @@ struct lang_type GTY(()) {tree t; };
#define SET_DECL_FUNCTION_STUB(NODE, X) \
SET_DECL_LANG_SPECIFIC (FUNCTION_DECL_CHECK (NODE), X)
/* In a PARM_DECL, points to the alternate TREE_TYPE */
#define DECL_PARM_ALT(NODE) \
/* In a PARM_DECL, points to the alternate TREE_TYPE. */
#define DECL_PARM_ALT_TYPE(NODE) \
GET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE))
#define SET_DECL_PARM_ALT(NODE, X) \
#define SET_DECL_PARM_ALT_TYPE(NODE, X) \
SET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE), X)
/* In a FIELD_DECL corresponding to a discriminant, contains the

View File

@ -4841,11 +4841,11 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
gnu_param_type
= TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_param_type))));
/* VMS descriptors are themselves passed by reference.
Build both a 32bit and 64bit descriptor, one of which will be chosen
in fill_vms_descriptor. */
/* VMS descriptors are themselves passed by reference. */
if (mech == By_Descriptor)
{
/* Build both a 32-bit and 64-bit descriptor, one of which will be
chosen in fill_vms_descriptor. */
gnu_param_type_alt
= build_pointer_type (build_vms_descriptor32 (gnu_param_type,
Mechanism (gnat_param),
@ -4856,14 +4856,10 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
gnat_subprog));
}
else if (mech == By_Short_Descriptor)
{
gnu_param_type_alt = NULL_TREE;
gnu_param_type
= build_pointer_type (build_vms_descriptor32 (gnu_param_type,
gnu_param_type
= build_pointer_type (build_vms_descriptor32 (gnu_param_type,
Mechanism (gnat_param),
gnat_subprog));
}
/* Arrays are passed as pointers to element type for foreign conventions. */
else if (foreign
@ -4961,8 +4957,9 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
DECL_POINTS_TO_READONLY_P (gnu_param)
= (ro_param && (by_ref || by_component_ptr));
/* Save the alternate descriptor for later. */
SET_DECL_PARM_ALT (gnu_param, gnu_param_type_alt);
/* Save the alternate descriptor type, if any. */
if (gnu_param_type_alt)
SET_DECL_PARM_ALT_TYPE (gnu_param, gnu_param_type_alt);
/* If no Mechanism was specified, indicate what we're using, then
back-annotate it. */

View File

@ -3564,54 +3564,45 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
gcc_unreachable ();
}
/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a
regular pointer or fat pointer type. GNAT_SUBPROG is the subprogram to
which the VMS descriptor is passed. */
/* 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. */
static tree
convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
convert_vms_descriptor (tree gnu_type, tree gnu_expr, tree gnu_expr_alt_type,
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 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (mbo)));
tree is64bit;
tree save_type = TREE_TYPE (gnu_expr);
tree gnu_expr32, gnu_expr64;
tree is64bit, gnu_expr32, gnu_expr64;
/* 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)
/* If the field name is not MBO, it must be 32bit and no alternate */
return convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
/* Otherwise primary must be 64bit and alternate 32bit */
/* Test for 64bit descriptor */
/* Build the test for 64-bit descriptor. */
mbo = build3 (COMPONENT_REF, TREE_TYPE (mbo), desc, mbo, NULL_TREE);
mbmo = build3 (COMPONENT_REF, TREE_TYPE (mbmo), desc, mbmo, NULL_TREE);
is64bit = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
build_binary_op (EQ_EXPR, integer_type_node,
convert (integer_type_node, mbo),
integer_one_node),
build_binary_op (EQ_EXPR, integer_type_node,
convert (integer_type_node, mbmo),
integer_minus_one_node));
is64bit
= build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
build_binary_op (EQ_EXPR, integer_type_node,
convert (integer_type_node, mbo),
integer_one_node),
build_binary_op (EQ_EXPR, integer_type_node,
convert (integer_type_node, mbmo),
integer_minus_one_node));
gnu_expr64 = convert_vms_descriptor64 (gnu_type, gnu_expr,
gnat_subprog);
/* Convert 32bit alternate. Hack alert ??? */
TREE_TYPE (gnu_expr) = DECL_PARM_ALT (gnu_expr);
gnu_expr32 = convert_vms_descriptor32 (gnu_type, gnu_expr,
gnat_subprog);
TREE_TYPE (gnu_expr) = save_type;
/* Build the 2 possible end results. */
gnu_expr64 = convert_vms_descriptor64 (gnu_type, gnu_expr, gnat_subprog);
gnu_expr = fold_convert (gnu_expr_alt_type, gnu_expr);
gnu_expr32 = convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
if (POINTER_TYPE_P (gnu_type))
return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
else if (TYPE_FAT_POINTER_P (gnu_type))
return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
else
gcc_unreachable ();
return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
}
/* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG
@ -3642,8 +3633,11 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
gnu_arg_types = TREE_CHAIN (gnu_arg_types))
{
if (DECL_BY_DESCRIPTOR_P (gnu_stub_param))
gnu_param = convert_vms_descriptor (TREE_VALUE (gnu_arg_types),
gnu_stub_param, gnat_subprog);
gnu_param
= convert_vms_descriptor (TREE_VALUE (gnu_arg_types),
gnu_stub_param,
DECL_PARM_ALT_TYPE (gnu_stub_param),
gnat_subprog);
else
gnu_param = gnu_stub_param;