aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/gcc-interface
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2008-08-01 14:02:10 +0000
committerEric Botcazou <ebotcazou@gcc.gnu.org>2008-08-01 14:02:10 +0000
commita981c964023a0ce4a6450c7ebd059450d81cbc1e (patch)
tree0c627408280bbfa72c8c792436ff4b7096d2bb97 /gcc/ada/gcc-interface
parentde1132d194a883fb817520e0c1f1a44b294fd7f5 (diff)
downloadgcc-a981c964023a0ce4a6450c7ebd059450d81cbc1e.zip
gcc-a981c964023a0ce4a6450c7ebd059450d81cbc1e.tar.gz
gcc-a981c964023a0ce4a6450c7ebd059450d81cbc1e.tar.bz2
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
Diffstat (limited to 'gcc/ada/gcc-interface')
-rw-r--r--gcc/ada/gcc-interface/ada-tree.h6
-rw-r--r--gcc/ada/gcc-interface/decl.c19
-rw-r--r--gcc/ada/gcc-interface/utils.c66
3 files changed, 41 insertions, 50 deletions
diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h
index 9472995..1db5ce2 100644
--- a/gcc/ada/gcc-interface/ada-tree.h
+++ b/gcc/ada/gcc-interface/ada-tree.h
@@ -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
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index bc17235..c9e9045 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -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. */
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index f1c673a8..dcf0558 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -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));
-
- 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;
-
- 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 ();
+ 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));
+
+ /* 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);
+
+ 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;