From c95f808ddd5046573423c9d1ee148645e5340738 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 3 Mar 2020 17:57:51 +0000 Subject: [PATCH] [Ada] AI12-0028-1 Import of variadic C functions 2020-06-19 Eric Botcazou gcc/ada/ * gcc-interface/decl.c (gnat_to_gnu_param): Tidy up. (gnat_to_gnu_subprog_type): For a variadic C function, do not build unnamed parameters and do not add final void node. * gcc-interface/misc.c: Include snames.h. * gcc-interface/trans.c (Attribute_to_gnu): Tidy up. (Call_to_gnu): Implement support for unnamed parameters in a variadic C function. * gcc-interface/utils.c: Include snames.h. (copy_type): Tidy up. --- gcc/ada/gcc-interface/decl.c | 20 ++--- gcc/ada/gcc-interface/misc.c | 1 + gcc/ada/gcc-interface/trans.c | 142 +++++++++++++++++++++++++++------- gcc/ada/gcc-interface/utils.c | 3 +- 4 files changed, 130 insertions(+), 36 deletions(-) diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 38c73cb4b44..33d59d556a2 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -5401,8 +5401,8 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, tree unpadded_type = TREE_TYPE (TYPE_FIELDS (gnu_param_type)); if (foreign - || (!must_pass_by_ref (unpadded_type) - && mech != By_Reference + || (mech != By_Reference + && !must_pass_by_ref (unpadded_type) && (mech == By_Copy || !default_pass_by_ref (unpadded_type)) && TYPE_ALIGN (unpadded_type) >= TYPE_ALIGN (gnu_param_type))) gnu_param_type = unpadded_type; @@ -5424,11 +5424,6 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, gnu_param_type = TREE_TYPE (gnu_param_type); gnu_param_type = TREE_TYPE (gnu_param_type); - - if (ro_param) - gnu_param_type - = change_qualified_type (gnu_param_type, TYPE_QUAL_CONST); - gnu_param_type = build_pointer_type (gnu_param_type); by_component_ptr = true; } @@ -5760,6 +5755,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, { const Entity_Kind kind = Ekind (gnat_subprog); const bool method_p = is_cplusplus_method (gnat_subprog); + const bool variadic = IN (Convention (gnat_subprog), Convention_C_Variadic); Entity_Id gnat_return_type = Etype (gnat_subprog); Entity_Id gnat_param; tree gnu_type = present_gnu_tree (gnat_subprog) @@ -5792,7 +5788,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, bool return_by_invisi_ref_p = false; bool return_unconstrained_p = false; bool incomplete_profile_p = false; - unsigned int num; + int num; /* Look into the return type and get its associated GCC tree if it is not void, and then compute various flags for the subprogram type. But make @@ -5962,6 +5958,11 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, tree gnu_param, gnu_param_type; bool cico = false; + /* For a variadic C function, do not build unnamed parameters. */ + if (variadic + && num == (Convention (gnat_subprog) - Convention_C_Variadic_0)) + break; + /* Fetch an existing parameter with complete type and reuse it. But we didn't save the CICO property so we can only do it for In parameters or parameters passed by reference. */ @@ -6195,7 +6196,8 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, /* The lists have been built in reverse. */ gnu_param_type_list = nreverse (gnu_param_type_list); - gnu_param_type_list = chainon (gnu_param_type_list, void_list_node); + if (!variadic) + gnu_param_type_list = chainon (gnu_param_type_list, void_list_node); gnu_param_list = nreverse (gnu_param_list); gnu_cico_list = nreverse (gnu_cico_list); diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index f72122bf5e0..f360ad4da22 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -47,6 +47,7 @@ #include "atree.h" #include "namet.h" #include "nlists.h" +#include "snames.h" #include "uintp.h" #include "fe.h" #include "sinfo.h" diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index b60b03d9ebb..5a93c433ec1 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -2065,7 +2065,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) case Attr_Range_Length: prefix_unused = true; - if (INTEGRAL_TYPE_P (gnu_type) || TREE_CODE (gnu_type) == REAL_TYPE) + if (INTEGRAL_TYPE_P (gnu_type) || SCALAR_FLOAT_TYPE_P (gnu_type)) { gnu_result_type = get_unpadded_type (Etype (gnat_node)); @@ -4457,9 +4457,10 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, tree gnu_after_list = NULL_TREE; tree gnu_retval = NULL_TREE; tree gnu_call, gnu_result; - bool by_descriptor = false; bool went_into_elab_proc = false; bool pushed_binding_level = false; + bool variadic; + bool by_descriptor; Entity_Id gnat_formal; Node_Id gnat_actual; atomic_acces_t aa_type; @@ -4505,20 +4506,32 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, entity being called. */ if (Nkind (Name (gnat_node)) == N_Explicit_Dereference) { + const Entity_Id gnat_prefix_type + = Underlying_Type (Etype (Prefix (Name (gnat_node)))); + gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node))); + variadic = IN (Convention (gnat_prefix_type), Convention_C_Variadic); /* If the access type doesn't require foreign-compatible representation, be prepared for descriptors. */ - if (targetm.calls.custom_function_descriptors > 0 - && Can_Use_Internal_Rep - (Underlying_Type (Etype (Prefix (Name (gnat_node)))))) - by_descriptor = true; + by_descriptor + = targetm.calls.custom_function_descriptors > 0 + && Can_Use_Internal_Rep (gnat_prefix_type); } else if (Nkind (Name (gnat_node)) == N_Attribute_Reference) - /* Assume here that this must be 'Elab_Body or 'Elab_Spec. */ - gnat_formal = Empty; + { + /* Assume here that this must be 'Elab_Body or 'Elab_Spec. */ + gnat_formal = Empty; + variadic = false; + by_descriptor = false; + } else - gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node))); + { + gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node))); + variadic + = IN (Convention (Entity (Name (gnat_node))), Convention_C_Variadic); + by_descriptor = false; + } /* The lifetime of the temporaries created for the call ends right after the return value is copied, so we can give them the scope of the elaboration @@ -4853,27 +4866,12 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual); } - /* Otherwise the parameter is passed by copy. */ - else + /* Then see if the parameter is passed by copy. */ + else if (is_true_formal_parm) { if (!in_param) gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list); - /* If we didn't create a PARM_DECL for the formal, this means that - it is an Out parameter not passed by reference and that need not - be copied in. In this case, the value of the actual need not be - read. However, we still need to make sure that its side-effects - are evaluated before the call, so we evaluate its address. */ - if (!is_true_formal_parm) - { - if (TREE_SIDE_EFFECTS (gnu_name)) - { - tree addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_name); - append_to_statement_list (addr, &gnu_stmt_list); - } - continue; - } - gnu_actual = convert (gnu_formal_type, gnu_actual); /* If this is a front-end built-in function, there is no need to @@ -4882,6 +4880,98 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, gnu_actual = convert (DECL_ARG_TYPE (gnu_formal), gnu_actual); } + /* Then see if this is an unnamed parameter in a variadic C function. */ + else if (variadic) + { + /* This is based on the processing done in gnat_to_gnu_param, but + we expect the mechanism to be set in (almost) all cases. */ + const Mechanism_Type mech = Mechanism (gnat_formal); + + /* Strip off possible padding type. */ + if (TYPE_IS_PADDING_P (gnu_formal_type)) + gnu_formal_type = TREE_TYPE (TYPE_FIELDS (gnu_formal_type)); + + /* Arrays are passed as pointers to element type. First check for + unconstrained array and get the underlying array. */ + if (TREE_CODE (gnu_formal_type) == UNCONSTRAINED_ARRAY_TYPE) + gnu_formal_type + = TREE_TYPE + (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_formal_type)))); + + /* Arrays are passed as pointers to element type. */ + if (mech != By_Copy && TREE_CODE (gnu_formal_type) == ARRAY_TYPE) + { + gnu_actual = maybe_implicit_deref (gnu_actual); + gnu_actual = maybe_unconstrained_array (gnu_actual); + + /* Strip off any multi-dimensional entries, then strip + off the last array to get the component type. */ + while (TREE_CODE (TREE_TYPE (gnu_formal_type)) == ARRAY_TYPE + && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_formal_type))) + gnu_formal_type = TREE_TYPE (gnu_formal_type); + + gnu_formal_type = TREE_TYPE (gnu_formal_type); + gnu_formal_type = build_pointer_type (gnu_formal_type); + gnu_actual + = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual); + } + + /* Fat pointers are passed as thin pointers. */ + else if (TYPE_IS_FAT_POINTER_P (gnu_formal_type)) + gnu_formal_type + = make_type_from_size (gnu_formal_type, + size_int (POINTER_SIZE), 0); + + /* If we were requested or muss pass by reference, do so. + If we were requested to pass by copy, do so. + Otherwise, pass In Out or Out parameters or aggregates by + reference. */ + else if (mech == By_Reference + || must_pass_by_ref (gnu_formal_type) + || (mech != By_Copy + && (!in_param || AGGREGATE_TYPE_P (gnu_formal_type)))) + { + gnu_formal_type = build_reference_type (gnu_formal_type); + gnu_actual + = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual); + } + + /* Otherwise pass by copy after applying default C promotions. */ + else + { + if (INTEGRAL_TYPE_P (gnu_formal_type) + && TYPE_PRECISION (gnu_formal_type) + < TYPE_PRECISION (integer_type_node)) + gnu_formal_type = integer_type_node; + + else if (SCALAR_FLOAT_TYPE_P (gnu_formal_type) + && TYPE_PRECISION (gnu_formal_type) + < TYPE_PRECISION (double_type_node)) + gnu_formal_type = double_type_node; + } + + gnu_actual = convert (gnu_formal_type, gnu_actual); + } + + /* If we didn't create a PARM_DECL for the formal, this means that + it is an Out parameter not passed by reference and that need not + be copied in. In this case, the value of the actual need not be + read. However, we still need to make sure that its side-effects + are evaluated before the call, so we evaluate its address. */ + else + { + if (!in_param) + gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list); + + if (TREE_SIDE_EFFECTS (gnu_name)) + { + tree addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_name); + append_to_statement_list (addr, &gnu_stmt_list); + } + + continue; + } + gnu_actual_vec.safe_push (gnu_actual); } diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index fb08b6c90ed..2a6ed04756b 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -50,6 +50,7 @@ #include "types.h" #include "atree.h" #include "nlists.h" +#include "snames.h" #include "uintp.h" #include "fe.h" #include "sinfo.h" @@ -2561,7 +2562,7 @@ copy_type (tree type) } /* And the contents of the language-specific slot if needed. */ - if ((INTEGRAL_TYPE_P (type) || TREE_CODE (type) == REAL_TYPE) + if ((INTEGRAL_TYPE_P (type) || SCALAR_FLOAT_TYPE_P (type)) && TYPE_RM_VALUES (type)) { TYPE_RM_VALUES (new_type) = NULL_TREE; -- 2.30.2