diff options
Diffstat (limited to 'gcc/ada/gcc-interface/utils.c')
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 49 |
1 files changed, 34 insertions, 15 deletions
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 84eb1ae..6ee95b7 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -3171,24 +3171,35 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) /* 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); @@ -3203,9 +3214,13 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, tree gnu_expr_alt_type, 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); } @@ -3217,7 +3232,7 @@ void 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; @@ -3235,17 +3250,21 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog) /* 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; |