+
+/* Similar, but for RETURN_EXPR. If RET_VAL is non-null, build a RETURN_EXPR
+ around the assignment of RET_VAL to RET_OBJ. Otherwise just build a bare
+ RETURN_EXPR around RESULT_OBJ, which may be null in this case. */
+
+static tree
+build_return_expr (tree ret_obj, tree ret_val)
+{
+ tree result_expr;
+
+ if (ret_val)
+ {
+ /* The gimplifier explicitly enforces the following invariant:
+
+ RETURN_EXPR
+ |
+ MODIFY_EXPR
+ / \
+ / \
+ RET_OBJ ...
+
+ As a consequence, type consistency dictates that we use the type
+ of the RET_OBJ as the operation type. */
+ tree operation_type = TREE_TYPE (ret_obj);
+
+ /* Convert the right operand to the operation type. Note that it's the
+ same transformation as in the MODIFY_EXPR case of build_binary_op,
+ with the assumption that the type cannot involve a placeholder. */
+ if (operation_type != TREE_TYPE (ret_val))
+ ret_val = convert (operation_type, ret_val);
+
+ result_expr = build2 (MODIFY_EXPR, void_type_node, ret_obj, ret_val);
+ }
+ else
+ result_expr = ret_obj;
+
+ return build1 (RETURN_EXPR, void_type_node, result_expr);
+}
+
+/* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG
+ and the GNAT node GNAT_SUBPROG. */
+
+static void
+build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
+{
+ tree gnu_subprog_type, gnu_subprog_addr, gnu_subprog_call;
+ 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;
+
+ gnu_subprog_type = TREE_TYPE (gnu_subprog);
+
+ /* Initialize the information structure for the function. */
+ allocate_struct_function (gnu_stub_decl, false);
+ set_cfun (NULL);
+
+ begin_subprog_body (gnu_stub_decl);
+
+ start_stmt_group ();
+ gnat_pushlevel ();
+
+ /* 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_subprog_param = DECL_ARGUMENTS (gnu_subprog);
+ gnu_stub_param;
+ gnu_stub_param = TREE_CHAIN (gnu_stub_param),
+ gnu_subprog_param = TREE_CHAIN (gnu_subprog_param))
+ {
+ if (DECL_BY_DESCRIPTOR_P (gnu_stub_param))
+ {
+ 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;
+
+ VEC_safe_push (tree, gc, gnu_param_vec, gnu_param);
+ }
+
+ /* Invoke the internal subprogram. */
+ gnu_subprog_addr = build1 (ADDR_EXPR, build_pointer_type (gnu_subprog_type),
+ gnu_subprog);
+ gnu_subprog_call = build_call_vec (TREE_TYPE (gnu_subprog_type),
+ gnu_subprog_addr, gnu_param_vec);
+
+ /* Propagate the return value, if any. */
+ if (VOID_TYPE_P (TREE_TYPE (gnu_subprog_type)))
+ add_stmt (gnu_subprog_call);
+ else
+ add_stmt (build_return_expr (DECL_RESULT (gnu_stub_decl),
+ gnu_subprog_call));
+
+ gnat_poplevel ();
+ end_subprog_body (end_stmt_group ());
+}