diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 17 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/ada-tree.h | 10 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 30 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/gigi.h | 5 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/misc.c | 10 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 18 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 49 |
7 files changed, 107 insertions, 32 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ab08310..31316e2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2010-10-10 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/ada-tree.h (DECL_BY_DOUBLE_REF_P): New macro. + * gcc-interface/gigi.h (annotate_object): Add BY_DOUBLE_REF parameter. + * gcc-interface/decl.c (annotate_object): Likewise and handle it. + (gnat_to_gnu_entity): Adjust calls to annotate_object. + (gnat_to_gnu_param): If fat pointer types are passed by reference on + the target, pass them by explicit reference. + * gcc-interface/misc.c (default_pass_by_ref): Fix type of constant. + * gcc-interface/trans.c (Identifier_to_gnu): Do DECL_BY_DOUBLE_REF_P. + (Subprogram_Body_to_gnu): Adjust call to annotate_object. + (call_to_gnu): Handle DECL_BY_DOUBLE_REF_P. + * gcc-interface/utils.c (convert_vms_descriptor): Add BY_REF parameter + and handle it. + (build_function_stub): Iterate on the parameters of the subprogram in + lieu of on the argument types. Adjust call to convert_vms_descriptor. + 2010-10-09 Eric Botcazou <ebotcazou@adacore.com> * gcc-interface/misc.c: Delete prototypes. diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 5092ff3..9002fa1 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -332,14 +332,18 @@ do { \ constant CONSTRUCTOR. */ #define DECL_CONST_ADDRESS_P(NODE) DECL_LANG_FLAG_0 (CONST_DECL_CHECK (NODE)) -/* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF +/* Nonzero in a PARM_DECL if it is always used by double reference, i.e. a + pair of INDIRECT_REFs is needed to access the object. */ +#define DECL_BY_DOUBLE_REF_P(NODE) DECL_LANG_FLAG_0 (PARM_DECL_CHECK (NODE)) + +/* Nonzero in a DECL if it is always used by reference, i.e. an INDIRECT_REF is needed to access the object. */ #define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE) /* Nonzero in a FIELD_DECL that is a dummy built for some internal reason. */ #define DECL_INTERNAL_P(NODE) DECL_LANG_FLAG_3 (FIELD_DECL_CHECK (NODE)) -/* Nonzero if this decl is a PARM_DECL for an Ada array being passed to a +/* Nonzero in a PARM_DECL if it is made for an Ada array being passed to a foreign convention subprogram. */ #define DECL_BY_COMPONENT_PTR_P(NODE) DECL_LANG_FLAG_3 (PARM_DECL_CHECK (NODE)) @@ -347,7 +351,7 @@ do { \ #define DECL_ELABORATION_PROC_P(NODE) \ DECL_LANG_FLAG_3 (FUNCTION_DECL_CHECK (NODE)) -/* Nonzero if this is a decl for a pointer that points to something which +/* Nonzero in a DECL if it is made for a pointer that points to something which is readonly. Used mostly for fat pointers. */ #define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (NODE) diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 0669875..98ca932 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -972,7 +972,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) save_gnu_tree (gnat_entity, gnu_decl, true); saved = true; annotate_object (gnat_entity, gnu_type, NULL_TREE, - false); + false, false); break; } @@ -1471,7 +1471,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) type of the object and not on the object directly, and makes it possible to support all confirming representation clauses. */ annotate_object (gnat_entity, TREE_TYPE (gnu_decl), gnu_object_size, - used_by_ref); + used_by_ref, false); } break; @@ -5282,7 +5282,8 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, bool in_param = (Ekind (gnat_param) == E_In_Parameter); /* The parameter can be indirectly modified if its address is taken. */ bool ro_param = in_param && !Address_Taken (gnat_param); - bool by_return = false, by_component_ptr = false, by_ref = false; + bool by_return = false, by_component_ptr = false; + bool by_ref = false, by_double_ref = false; tree gnu_param; /* Copy-return is used only for the first parameter of a valued procedure. @@ -5399,6 +5400,19 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, { gnu_param_type = build_reference_type (gnu_param_type); by_ref = true; + + /* In some ABIs, e.g. SPARC 32-bit, fat pointer types are themselves + passed by reference. Pass them by explicit reference, this will + generate more debuggable code at -O0. */ + if (TYPE_IS_FAT_POINTER_P (gnu_param_type) + && targetm.calls.pass_by_reference (NULL, + TYPE_MODE (gnu_param_type), + gnu_param_type, + true)) + { + gnu_param_type = build_reference_type (gnu_param_type); + by_double_ref = true; + } } /* Pass In Out or Out parameters using copy-in copy-out mechanism. */ @@ -5441,6 +5455,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, gnu_param = create_param_decl (gnu_param_name, gnu_param_type, ro_param || by_ref || by_component_ptr); DECL_BY_REF_P (gnu_param) = by_ref; + DECL_BY_DOUBLE_REF_P (gnu_param) = by_double_ref; DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr; DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor || mech == By_Short_Descriptor); @@ -7397,13 +7412,18 @@ annotate_value (tree gnu_size) /* Given GNAT_ENTITY, an object (constant, variable, parameter, exception) and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the size and alignment used by Gigi. Prefer SIZE over TYPE_SIZE if non-null. - BY_REF is true if the object is used by reference. */ + BY_REF is true if the object is used by reference and BY_DOUBLE_REF is + true if the object is used by double reference. */ void -annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref) +annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref, + bool by_double_ref) { if (by_ref) { + if (by_double_ref) + gnu_type = TREE_TYPE (gnu_type); + if (TYPE_IS_FAT_POINTER_P (gnu_type)) gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type); else diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index dd30b24..2fa2a07 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -139,9 +139,10 @@ extern tree choices_to_gnu (tree operand, Node_Id choices); /* Given GNAT_ENTITY, an object (constant, variable, parameter, exception) and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the size and alignment used by Gigi. Prefer SIZE over TYPE_SIZE if non-null. - BY_REF is true if the object is used by reference. */ + BY_REF is true if the object is used by reference and BY_DOUBLE_REF is + true if the object is used by double reference. */ extern void annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, - bool by_ref); + bool by_ref, bool by_double_ref); /* Given a type T, a FIELD_DECL F, and a replacement value R, return a new type with all size expressions that contain F updated by replacing F diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 07b3acf..0dd29a6 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -619,8 +619,8 @@ gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval) *highval = TYPE_MAX_VALUE (gnu_type); } -/* GNU_TYPE is a type. Determine if it should be passed by reference by - default. */ +/* GNU_TYPE is the type of a subprogram parameter. Determine if it should be + passed by reference by default. */ bool default_pass_by_ref (tree gnu_type) @@ -632,7 +632,7 @@ default_pass_by_ref (tree gnu_type) is an In Out parameter, but it's probably best to err on the side of passing more things by reference. */ - if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, 1)) + if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true)) return true; if (targetm.calls.return_in_memory (gnu_type, NULL_TREE)) @@ -647,8 +647,8 @@ default_pass_by_ref (tree gnu_type) return false; } -/* GNU_TYPE is the type of a subprogram parameter. Determine from the type if - it should be passed by reference. */ +/* GNU_TYPE is the type of a subprogram parameter. Determine if it must be + passed by reference. */ bool must_pass_by_ref (tree gnu_type) diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 7031bfb..36a2462 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -989,6 +989,10 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) tree renamed_obj; if (TREE_CODE (gnu_result) == PARM_DECL + && DECL_BY_DOUBLE_REF_P (gnu_result)) + gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result); + + if (TREE_CODE (gnu_result) == PARM_DECL && DECL_BY_COMPONENT_PTR_P (gnu_result)) gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, @@ -2595,9 +2599,13 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) gnat_param = Next_Formal_With_Extras (gnat_param)) { tree gnu_param = get_gnu_tree (gnat_param); + bool is_var_decl = (TREE_CODE (gnu_param) == VAR_DECL); + annotate_object (gnat_param, TREE_TYPE (gnu_param), NULL_TREE, - DECL_BY_REF_P (gnu_param)); - if (TREE_CODE (gnu_param) == VAR_DECL) + DECL_BY_REF_P (gnu_param), + !is_var_decl && DECL_BY_DOUBLE_REF_P (gnu_param)); + + if (is_var_decl) save_gnu_tree (gnat_param, NULL_TREE, false); } @@ -2900,6 +2908,12 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) /* The symmetry of the paths to the type of an entity is broken here since arguments don't know that they will be passed by ref. */ gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal)); + + if (DECL_BY_DOUBLE_REF_P (gnu_formal)) + gnu_actual + = build_unary_op (ADDR_EXPR, TREE_TYPE (gnu_formal_type), + gnu_actual); + gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual); } else if (gnu_formal 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; |