diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/ada-tree.h | 9 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 66 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 29 |
3 files changed, 64 insertions, 40 deletions
diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 2d0e6e4..150dd86 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -426,6 +426,15 @@ do { \ SET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE), X) +/* Flags added to ref nodes. */ + +/* Nonzero means this node will not trap. */ +#undef TREE_THIS_NOTRAP +#define TREE_THIS_NOTRAP(NODE) \ + (TREE_CHECK4 (NODE, INDIRECT_REF, ARRAY_REF, UNCONSTRAINED_ARRAY_REF, \ + ARRAY_RANGE_REF)->base.nothrow_flag) + + /* Fields and macros for statements. */ #define IS_ADA_STMT(NODE) \ (STATEMENT_CLASS_P (NODE) && TREE_CODE (NODE) >= STMT_STMT) diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 2f41ad3..7357986 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -989,8 +989,8 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) && DECL_BY_COMPONENT_PTR_P (gnu_result)))) { const bool read_only = DECL_POINTS_TO_READONLY_P (gnu_result); - tree renamed_obj; + /* First do the first dereference if needed. */ if (TREE_CODE (gnu_result) == PARM_DECL && DECL_BY_DOUBLE_REF_P (gnu_result)) { @@ -999,42 +999,37 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) TREE_THIS_NOTRAP (gnu_result) = 1; } + /* If it's a PARM_DECL to foreign convention subprogram, convert it. */ if (TREE_CODE (gnu_result) == PARM_DECL && DECL_BY_COMPONENT_PTR_P (gnu_result)) - { - gnu_result - = build_unary_op (INDIRECT_REF, NULL_TREE, - convert (build_pointer_type (gnu_result_type), - gnu_result)); - if (TREE_CODE (gnu_result) == INDIRECT_REF) - TREE_THIS_NOTRAP (gnu_result) = 1; - } + gnu_result + = convert (build_pointer_type (gnu_result_type), gnu_result); + + /* If it's a CONST_DECL, return the underlying constant like below. */ + else if (TREE_CODE (gnu_result) == CONST_DECL) + gnu_result = DECL_INITIAL (gnu_result); /* If it's a renaming pointer and we are at the right binding level, we can reference the renamed object directly, since the renamed expression has been protected against multiple evaluations. */ - else if (TREE_CODE (gnu_result) == VAR_DECL - && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result)) - && (!DECL_RENAMING_GLOBAL_P (gnu_result) - || global_bindings_p ())) - gnu_result = renamed_obj; - - /* Return the underlying CST for a CONST_DECL like a few lines below, - after dereferencing in this case. */ - else if (TREE_CODE (gnu_result) == CONST_DECL) - gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, - DECL_INITIAL (gnu_result)); + if (TREE_CODE (gnu_result) == VAR_DECL + && DECL_RENAMED_OBJECT (gnu_result) + && (!DECL_RENAMING_GLOBAL_P (gnu_result) || global_bindings_p ())) + gnu_result = DECL_RENAMED_OBJECT (gnu_result); + /* Otherwise, do the final dereference. */ else { gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result); - if (TREE_CODE (gnu_result) == INDIRECT_REF + + if ((TREE_CODE (gnu_result) == INDIRECT_REF + || TREE_CODE (gnu_result) == UNCONSTRAINED_ARRAY_REF) && No (Address_Clause (gnat_temp))) TREE_THIS_NOTRAP (gnu_result) = 1; - } - if (read_only) - TREE_READONLY (gnu_result) = 1; + if (read_only) + TREE_READONLY (gnu_result) = 1; + } } /* The GNAT tree has the type of a function as the type of its result. Also @@ -1597,11 +1592,26 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) /* Make sure any implicit dereference gets done. */ gnu_prefix = maybe_implicit_deref (gnu_prefix); gnu_prefix = maybe_unconstrained_array (gnu_prefix); + /* We treat unconstrained array In parameters specially. */ - if (Nkind (Prefix (gnat_node)) == N_Identifier - && !Is_Constrained (Etype (Prefix (gnat_node))) - && Ekind (Entity (Prefix (gnat_node))) == E_In_Parameter) - gnat_param = Entity (Prefix (gnat_node)); + if (!Is_Constrained (Etype (Prefix (gnat_node)))) + { + Node_Id gnat_prefix = Prefix (gnat_node); + + /* This is the direct case. */ + if (Nkind (gnat_prefix) == N_Identifier + && Ekind (Entity (gnat_prefix)) == E_In_Parameter) + gnat_param = Entity (gnat_prefix); + + /* This is the indirect case. Note that we need to be sure that + the access value cannot be null as we'll hoist the load. */ + if (Nkind (gnat_prefix) == N_Explicit_Dereference + && Nkind (Prefix (gnat_prefix)) == N_Identifier + && Ekind (Entity (Prefix (gnat_prefix))) == E_In_Parameter + && Can_Never_Be_Null (Entity (Prefix (gnat_prefix)))) + gnat_param = Entity (Prefix (gnat_prefix)); + } + gnu_type = TREE_TYPE (gnu_prefix); prefix_unused = true; gnu_result_type = get_unpadded_type (Etype (gnat_node)); diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 0176c3e..de9256a 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -3947,17 +3947,21 @@ convert (tree type, tree expr) break; case UNCONSTRAINED_ARRAY_REF: - /* Convert this to the type of the inner array by getting the address of - the array from the template. */ - expr = TREE_OPERAND (expr, 0); - expr = build_unary_op (INDIRECT_REF, NULL_TREE, - build_component_ref (expr, NULL_TREE, - TYPE_FIELDS - (TREE_TYPE (expr)), - false)); - etype = TREE_TYPE (expr); - ecode = TREE_CODE (etype); - break; + { + /* Convert this to the type of the inner array by getting the address + of the array from the template. */ + const bool no_trap = TREE_THIS_NOTRAP (expr); + expr = TREE_OPERAND (expr, 0); + expr = build_unary_op (INDIRECT_REF, NULL_TREE, + build_component_ref (expr, NULL_TREE, + TYPE_FIELDS + (TREE_TYPE (expr)), + false)); + TREE_THIS_NOTRAP (expr) = no_trap; + etype = TREE_TYPE (expr); + ecode = TREE_CODE (etype); + break; + } case VIEW_CONVERT_EXPR: { @@ -3992,8 +3996,9 @@ convert (tree type, tree expr) && !TYPE_IS_FAT_POINTER_P (etype)) return convert (type, op0); } + + break; } - break; default: break; |