diff options
Diffstat (limited to 'gcc/ada/gcc-interface/trans.cc')
| -rw-r--r-- | gcc/ada/gcc-interface/trans.cc | 326 |
1 files changed, 283 insertions, 43 deletions
diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index 2d93947..d0ff741 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -1033,7 +1033,7 @@ fold_constant_decl_in_expr (tree exp) return exp; return fold (build4 (code, TREE_TYPE (exp), op0, TREE_OPERAND (exp, 1), - TREE_OPERAND (exp, 2), NULL_TREE)); + TREE_OPERAND (exp, 2), TREE_OPERAND (exp, 3))); case REALPART_EXPR: case IMAGPART_EXPR: @@ -1671,6 +1671,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) tree gnu_type = TREE_TYPE (gnu_prefix); tree gnu_expr, gnu_result_type, gnu_result = error_mark_node; bool prefix_unused = false; + Entity_Id gnat_smo; /* If the input is a NULL_EXPR, make a new one. */ if (TREE_CODE (gnu_prefix) == NULL_EXPR) @@ -1680,6 +1681,14 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) return build1 (NULL_EXPR, gnu_result_type, TREE_OPERAND (gnu_prefix, 0)); } + /* If the input is a LOAD_EXPR of an unconstrained array type, the second + operand contains the storage model object. */ + if (TREE_CODE (gnu_prefix) == LOAD_EXPR + && TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE) + gnat_smo = tree_to_shwi (TREE_OPERAND (gnu_prefix, 1)); + else + gnat_smo = Empty; + switch (attribute) { case Attr_Pred: @@ -1960,7 +1969,11 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) /* Deal with a self-referential size by qualifying the size with the object or returning the maximum size for a type. */ if (TREE_CODE (gnu_prefix) != TYPE_DECL) - gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, gnu_prefix); + { + gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, gnu_prefix); + if (Present (gnat_smo)) + gnu_result = INSTANTIATE_LOAD_IN_EXPR (gnu_result, gnat_smo); + } else if (CONTAINS_PLACEHOLDER_P (gnu_result)) gnu_result = max_size (gnu_result, true); @@ -2191,6 +2204,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) handling. Note that these attributes could not have been used on an unconstrained array type. */ gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, gnu_prefix); + if (Present (gnat_smo)) + gnu_result = INSTANTIATE_LOAD_IN_EXPR (gnu_result, gnat_smo); /* Cache the expression we have just computed. Since we want to do it at run time, we force the use of a SAVE_EXPR and let the gimplifier @@ -2351,6 +2366,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) /* If this has a PLACEHOLDER_EXPR, qualify it by the object we are handling. */ gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, gnu_prefix); + if (Present (gnat_smo)) + gnu_result = INSTANTIATE_LOAD_IN_EXPR (gnu_result, gnat_smo); break; } @@ -4356,6 +4373,49 @@ simple_atomic_access_required_p (Node_Id gnat_node, bool *sync) return type == SIMPLE_ATOMIC; } +/* Return the storage model specified by GNAT_NODE, or else Empty. */ + +static Entity_Id +get_storage_model (Node_Id gnat_node) +{ + if (Nkind (gnat_node) == N_Explicit_Dereference + && Has_Designated_Storage_Model_Aspect (Etype (Prefix (gnat_node)))) + return Storage_Model_Object (Etype (Prefix (gnat_node))); + else + return Empty; +} + +/* Compute whether GNAT_NODE requires storage model access and set GNAT_SMO to + the storage model object to be used for it if it does, or else Empty. */ + +static void +get_storage_model_access (Node_Id gnat_node, Entity_Id *gnat_smo) +{ + const Node_Id gnat_parent = Parent (gnat_node); + + /* If we are the prefix of the parent, then the access is above us. */ + if (node_is_component (gnat_parent) && Prefix (gnat_parent) == gnat_node) + { + *gnat_smo = Empty; + return; + } + + while (node_is_component (gnat_node)) + gnat_node = Prefix (gnat_node); + + *gnat_smo = get_storage_model (gnat_node); +} + +/* Return true if GNAT_NODE requires storage model access and, if so, set + GNAT_SMO to the storage model object to be used for it. */ + +static bool +storage_model_access_required_p (Node_Id gnat_node, Entity_Id *gnat_smo) +{ + get_storage_model_access (gnat_node, gnat_smo); + return Present (*gnat_smo); +} + /* Create a temporary variable with PREFIX and TYPE, and return it. */ static tree @@ -4471,11 +4531,14 @@ elaborate_profile (Entity_Id first_formal, Entity_Id result_type) N_Assignment_Statement and the result is to be placed into that object. ATOMIC_ACCESS is the type of atomic access to be used for the assignment to GNU_TARGET. If, in addition, ATOMIC_SYNC is true, then the assignment - to GNU_TARGET requires atomic synchronization. */ + to GNU_TARGET requires atomic synchronization. GNAT_STORAGE_MODEL is the + storage model object to be used for the assignment to GNU_TARGET or Empty + if there is none. */ static tree Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, - atomic_acces_t atomic_access, bool atomic_sync) + atomic_acces_t atomic_access, bool atomic_sync, + Entity_Id gnat_storage_model) { const bool function_call = (Nkind (gnat_node) == N_Function_Call); const bool returning_value = (function_call && !gnu_target); @@ -4507,6 +4570,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, Node_Id gnat_actual; atomic_acces_t aa_type; bool aa_sync; + Entity_Id gnat_smo; /* The only way we can make a call via an access type is if GNAT_NAME is an explicit dereference. In that case, get the list of formal args from the @@ -4624,7 +4688,9 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, unconstrained record type with default discriminant, because the return may copy more data than the bit-field can contain. - 5. There is no target and we have misaligned In Out or Out parameters + 5. There is a target which needs to be accessed with a storage model. + + 6. There is no target and we have misaligned In Out or Out parameters passed by reference, because we need to preserve the return value before copying back the parameters. However, in this case, we'll defer creating the temporary, see below. @@ -4654,7 +4720,10 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, && DECL_BIT_FIELD (TREE_OPERAND (gnu_target, 1)) && DECL_SIZE (TREE_OPERAND (gnu_target, 1)) != TYPE_SIZE (TREE_TYPE (gnu_target)) - && type_is_padding_self_referential (gnu_result_type)))) + && type_is_padding_self_referential (gnu_result_type)) + || (gnu_target + && Present (gnat_storage_model) + && Present (Storage_Model_Copy_To (gnat_storage_model))))) { gnu_retval = create_temporary ("R", gnu_result_type); DECL_RETURN_VALUE_P (gnu_retval) = 1; @@ -4725,12 +4794,19 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, = build_compound_expr (TREE_TYPE (gnu_name), init, gnu_name); } - /* If we are passing a non-addressable parameter by reference, pass the - address of a copy. In the In Out or Out case, set up to copy back - out after the call. */ + get_storage_model_access (gnat_actual, &gnat_smo); + + /* If we are passing a non-addressable actual parameter by reference, + pass the address of a copy. Likewise if it needs to be accessed with + a storage model. In the In Out or Out case, set up to copy back out + after the call. */ if (is_by_ref_formal_parm && (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name))) - && !addressable_p (gnu_name, gnu_name_type)) + && (!addressable_p (gnu_name, gnu_name_type) + || (Present (gnat_smo) + && (Present (Storage_Model_Copy_From (gnat_smo)) + || (!in_param + && Present (Storage_Model_Copy_To (gnat_smo))))))) { tree gnu_orig = gnu_name, gnu_temp, gnu_stmt; @@ -4801,20 +4877,40 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, } /* Create an explicit temporary holding the copy. */ + tree gnu_temp_type; + if (Nkind (gnat_actual) == N_Explicit_Dereference + && Present (Actual_Designated_Subtype (gnat_actual))) + gnu_temp_type + = gnat_to_gnu_type (Actual_Designated_Subtype (gnat_actual)); + else + gnu_temp_type = TREE_TYPE (gnu_name); + /* Do not initialize it for the _Init parameter of an initialization procedure since no data is meant to be passed in. */ if (Ekind (gnat_formal) == E_Out_Parameter && Is_Entity_Name (gnat_subprog) && Is_Init_Proc (Entity (gnat_subprog))) - gnu_name = gnu_temp = create_temporary ("A", TREE_TYPE (gnu_name)); + gnu_name = gnu_temp = create_temporary ("A", gnu_temp_type); /* Initialize it on the fly like for an implicit temporary in the other cases, as we don't necessarily have a statement list. */ else { - gnu_temp = create_init_temporary ("A", gnu_name, &gnu_stmt, - gnat_actual); - gnu_name = build_compound_expr (TREE_TYPE (gnu_name), gnu_stmt, + if (Present (gnat_smo) + && Present (Storage_Model_Copy_From (gnat_smo))) + { + gnu_temp = create_temporary ("A", gnu_temp_type); + gnu_stmt + = build_storage_model_load (gnat_smo, gnu_temp, + gnu_name, + TYPE_SIZE_UNIT (gnu_temp_type)); + set_expr_location_from_node (gnu_stmt, gnat_actual); + } + else + gnu_temp = create_init_temporary ("A", gnu_name, &gnu_stmt, + gnat_actual); + + gnu_name = build_compound_expr (gnu_temp_type, gnu_stmt, gnu_temp); } @@ -4830,8 +4926,16 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, (TREE_OPERAND (TREE_OPERAND (gnu_orig, 1), 1))) gnu_orig = TREE_OPERAND (gnu_orig, 2); - gnu_stmt - = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig, gnu_temp); + if (Present (gnat_smo) + && Present (Storage_Model_Copy_To (gnat_smo))) + gnu_stmt + = build_storage_model_store (gnat_smo, gnu_orig, + gnu_temp, + TYPE_SIZE_UNIT (gnu_temp_type)); + else + gnu_stmt + = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig, + gnu_temp); set_expr_location_from_node (gnu_stmt, gnat_node); append_to_statement_list (gnu_stmt, &gnu_after_list); @@ -4842,12 +4946,19 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, tree gnu_actual = gnu_name; /* If atomic access is required for an In or In Out actual parameter, - build the atomic load. */ + build the atomic load. Or else, if storage model access is required, + build the special load. */ if (is_true_formal_parm && !is_by_ref_formal_parm - && Ekind (gnat_formal) != E_Out_Parameter - && simple_atomic_access_required_p (gnat_actual, &aa_sync)) - gnu_actual = build_atomic_load (gnu_actual, aa_sync); + && Ekind (gnat_formal) != E_Out_Parameter) + { + if (simple_atomic_access_required_p (gnat_actual, &aa_sync)) + gnu_actual = build_atomic_load (gnu_actual, aa_sync); + + else if (Present (gnat_smo) + && Present (Storage_Model_Copy_From (gnat_smo))) + gnu_actual = build_storage_model_load (gnat_smo, gnu_actual); + } /* If this was a procedure call, we may not have removed any padding. So do it here for the part we will use as an input, if any. */ @@ -5211,6 +5322,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, } get_atomic_access (gnat_actual, &aa_type, &aa_sync); + get_storage_model_access (gnat_actual, &gnat_smo); /* If an outer atomic access is required for an actual parameter, build the load-modify-store sequence. */ @@ -5224,6 +5336,13 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, gnu_result = build_atomic_store (gnu_actual, gnu_result, aa_sync); + /* Or else, if a storage model access is required, build the special + store. */ + else if (Present (gnat_smo) + && Present (Storage_Model_Copy_To (gnat_smo))) + gnu_result + = build_storage_model_store (gnat_smo, gnu_actual, gnu_result); + /* Otherwise build a regular assignment. */ else gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE, @@ -5298,6 +5417,11 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, = build_load_modify_store (gnu_target, gnu_call, gnat_node); else if (atomic_access == SIMPLE_ATOMIC) gnu_call = build_atomic_store (gnu_target, gnu_call, atomic_sync); + else if (Present (gnat_storage_model) + && Present (Storage_Model_Copy_To (gnat_storage_model))) + gnu_call + = build_storage_model_store (gnat_storage_model, gnu_target, + gnu_call); else gnu_call = build_binary_op (op_code, NULL_TREE, gnu_target, gnu_call); @@ -6104,6 +6228,7 @@ gnat_to_gnu (Node_Id gnat_node) atomic_acces_t aa_type; bool went_into_elab_proc; bool aa_sync; + Entity_Id gnat_smo; /* Save node number for error message and set location information. */ if (Sloc (gnat_node) > No_Location) @@ -6376,7 +6501,7 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result = Call_to_gnu (Prefix (Expression (gnat_node)), &gnu_result_type, gnu_result, - NOT_ATOMIC, false); + NOT_ATOMIC, false, Empty); break; } @@ -6522,15 +6647,25 @@ gnat_to_gnu (Node_Id gnat_node) if (simple_atomic_access_required_p (gnat_node, &aa_sync) && !present_in_lhs_or_actual_p (gnat_node)) gnu_result = build_atomic_load (gnu_result, aa_sync); + + /* If storage model access is required on the RHS, build the load. */ + else if (storage_model_access_required_p (gnat_node, &gnat_smo) + && Present (Storage_Model_Copy_From (gnat_smo)) + && !present_in_lhs_or_actual_p (gnat_node)) + gnu_result = build_storage_model_load (gnat_smo, gnu_result); break; case N_Indexed_Component: { - tree gnu_array_object = gnat_to_gnu ((Prefix (gnat_node))); + const Entity_Id gnat_array_object = Prefix (gnat_node); + tree gnu_array_object = gnat_to_gnu (gnat_array_object); tree gnu_type; int ndim, i; Node_Id *gnat_expr_array; + /* Get the storage model of the array. */ + gnat_smo = get_storage_model (gnat_array_object); + gnu_array_object = maybe_padded_object (gnu_array_object); gnu_array_object = maybe_unconstrained_array (gnu_array_object); @@ -6582,6 +6717,9 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result = build_binary_op (ARRAY_REF, NULL_TREE, gnu_result, gnu_expr); + + if (Present (gnat_smo)) + instantiate_load_in_array_ref (gnu_result, gnat_smo); } gnu_result_type = get_unpadded_type (Etype (gnat_node)); @@ -6590,18 +6728,28 @@ gnat_to_gnu (Node_Id gnat_node) if (simple_atomic_access_required_p (gnat_node, &aa_sync) && !present_in_lhs_or_actual_p (gnat_node)) gnu_result = build_atomic_load (gnu_result, aa_sync); + + /* If storage model access is required on the RHS, build the load. */ + else if (storage_model_access_required_p (gnat_node, &gnat_smo) + && Present (Storage_Model_Copy_From (gnat_smo)) + && !present_in_lhs_or_actual_p (gnat_node)) + gnu_result = build_storage_model_load (gnat_smo, gnu_result); } break; case N_Slice: { - tree gnu_array_object = gnat_to_gnu (Prefix (gnat_node)); + const Entity_Id gnat_array_object = Prefix (gnat_node); + tree gnu_array_object = gnat_to_gnu (gnat_array_object); - gnu_result_type = get_unpadded_type (Etype (gnat_node)); + /* Get the storage model of the array. */ + gnat_smo = get_storage_model (gnat_array_object); gnu_array_object = maybe_padded_object (gnu_array_object); gnu_array_object = maybe_unconstrained_array (gnu_array_object); + gnu_result_type = get_unpadded_type (Etype (gnat_node)); + gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type)); gnu_expr = maybe_character_value (gnu_expr); @@ -6614,6 +6762,15 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result = build_binary_op (ARRAY_RANGE_REF, gnu_result_type, gnu_array_object, gnu_expr); + + if (Present (gnat_smo)) + instantiate_load_in_array_ref (gnu_result, gnat_smo); + + /* If storage model access is required on the RHS, build the load. */ + if (storage_model_access_required_p (gnat_node, &gnat_smo) + && Present (Storage_Model_Copy_From (gnat_smo)) + && !present_in_lhs_or_actual_p (gnat_node)) + gnu_result = build_storage_model_load (gnat_smo, gnu_result); } break; @@ -6691,6 +6848,12 @@ gnat_to_gnu (Node_Id gnat_node) if (simple_atomic_access_required_p (gnat_node, &aa_sync) && !present_in_lhs_or_actual_p (gnat_node)) gnu_result = build_atomic_load (gnu_result, aa_sync); + + /* If storage model access is required on the RHS, build the load. */ + else if (storage_model_access_required_p (gnat_node, &gnat_smo) + && Present (Storage_Model_Copy_From (gnat_smo)) + && !present_in_lhs_or_actual_p (gnat_node)) + gnu_result = build_storage_model_load (gnat_smo, gnu_result); } break; @@ -7224,9 +7387,10 @@ gnat_to_gnu (Node_Id gnat_node) else if (Nkind (Expression (gnat_node)) == N_Function_Call) { get_atomic_access (Name (gnat_node), &aa_type, &aa_sync); + get_storage_model_access (Name (gnat_node), &gnat_smo); gnu_result = Call_to_gnu (Expression (gnat_node), &gnu_result_type, gnu_lhs, - aa_type, aa_sync); + aa_type, aa_sync, gnat_smo); } /* Otherwise we need to build the assignment statement manually. */ @@ -7264,6 +7428,7 @@ gnat_to_gnu (Node_Id gnat_node) gigi_checking_assert (!Do_Range_Check (gnat_expr)); get_atomic_access (Name (gnat_node), &aa_type, &aa_sync); + get_storage_model_access (Name (gnat_node), &gnat_smo); /* If an outer atomic access is required on the LHS, build the load- modify-store sequence. */ @@ -7275,6 +7440,43 @@ gnat_to_gnu (Node_Id gnat_node) else if (aa_type == SIMPLE_ATOMIC) gnu_result = build_atomic_store (gnu_lhs, gnu_rhs, aa_sync); + /* Or else, if a storage model access is required, build the special + store. */ + else if (Present (gnat_smo) + && Present (Storage_Model_Copy_To (gnat_smo))) + { + tree t = remove_conversions (gnu_rhs, false); + + /* If a storage model load is present on the RHS then instantiate + the temporary associated with it now, lest it be of variable + size and thus could not be instantiated by gimplification. */ + if (TREE_CODE (t) == LOAD_EXPR) + { + t = TREE_OPERAND (t, 1); + gcc_assert (TREE_CODE (t) == CALL_EXPR); + + tree elem + = build_nonstandard_integer_type (BITS_PER_UNIT, 1); + tree size = fold_convert (sizetype, CALL_EXPR_ARG (t, 3)); + tree index = build_index_type (size); + tree temp + = create_temporary ("L", build_array_type (elem, index)); + tree arg = CALL_EXPR_ARG (t, 1); + CALL_EXPR_ARG (t, 1) + = build_unary_op (ADDR_EXPR, TREE_TYPE (arg), temp); + + start_stmt_group (); + add_stmt (t); + t = build_storage_model_store (gnat_smo, gnu_lhs, temp); + add_stmt (t); + gnu_result = end_stmt_group (); + } + + else + gnu_result + = build_storage_model_store (gnat_smo, gnu_lhs, gnu_rhs); + } + /* Or else, use memset when the conditions are met. This has already been validated by Aggr_Assignment_OK_For_Backend in the front-end and the RHS is thus guaranteed to be of the appropriate form. */ @@ -7307,10 +7509,27 @@ gnat_to_gnu (Node_Id gnat_node) gnat_node); } - /* Otherwise build a regular assignment. */ else - gnu_result - = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs); + { + tree t = remove_conversions (gnu_rhs, false); + + /* If a storage model load is present on the RHS, then elide the + temporary associated with it. */ + if (TREE_CODE (t) == LOAD_EXPR) + { + gnu_result = TREE_OPERAND (t, 1); + gcc_assert (TREE_CODE (gnu_result) == CALL_EXPR); + + tree arg = CALL_EXPR_ARG (gnu_result, 1); + CALL_EXPR_ARG (gnu_result, 1) + = build_unary_op (ADDR_EXPR, TREE_TYPE (arg), gnu_lhs); + } + + /* Otherwise build a regular assignment. */ + else + gnu_result + = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs); + } /* If the assignment type is a regular array and the two sides are not completely disjoint, play safe and use memmove. But don't do @@ -7624,7 +7843,7 @@ gnat_to_gnu (Node_Id gnat_node) case N_Function_Call: case N_Procedure_Call_Statement: gnu_result = Call_to_gnu (gnat_node, &gnu_result_type, NULL_TREE, - NOT_ATOMIC, false); + NOT_ATOMIC, false, Empty); break; /************************/ @@ -8023,10 +8242,14 @@ gnat_to_gnu (Node_Id gnat_node) if (!type_annotate_only) { - tree gnu_ptr, gnu_ptr_type, gnu_obj_type, gnu_actual_obj_type; - const Entity_Id gnat_desig_type = Designated_Type (Underlying_Type (Etype (gnat_temp))); + const Entity_Id gnat_pool = Storage_Pool (gnat_node); + const bool pool_is_storage_model + = Present (gnat_pool) + && Has_Storage_Model_Type_Aspect (Etype (gnat_pool)) + && Present (Storage_Model_Copy_From (gnat_pool)); + tree gnu_ptr, gnu_ptr_type, gnu_obj_type, gnu_actual_obj_type; /* Make sure the designated type is complete before dereferencing, in case it is a Taft Amendment type. */ @@ -8087,12 +8310,13 @@ gnat_to_gnu (Node_Id gnat_node) tree gnu_size = TYPE_SIZE_UNIT (gnu_actual_obj_type); gnu_size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_size, gnu_ptr); + if (pool_is_storage_model) + gnu_size = INSTANTIATE_LOAD_IN_EXPR (gnu_size, gnat_pool); gnu_result = build_call_alloc_dealloc (gnu_ptr, gnu_size, gnu_obj_type, Procedure_To_Call (gnat_node), - Storage_Pool (gnat_node), - gnat_node); + gnat_pool, gnat_node); } break; @@ -8300,7 +8524,7 @@ gnat_to_gnu (Node_Id gnat_node) && return_type_with_variable_size_p (TREE_TYPE (gnu_result))) ; - else if (TREE_CODE (gnu_result) == UNCONSTRAINED_ARRAY_REF + else if (TREE_CODE (TREE_TYPE (gnu_result)) == UNCONSTRAINED_ARRAY_TYPE && Present (Parent (gnat_node)) && Nkind (Parent (gnat_node)) == N_Attribute_Reference && lvalue_required_for_attribute_p (Parent (gnat_node))) @@ -8739,7 +8963,7 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, avoid blocking concatenation in the caller when it is inlined. */ for (int i = 0; i < call_expr_nargs (expr); i++) { - tree arg = *(CALL_EXPR_ARGP (expr) + i); + tree arg = CALL_EXPR_ARG (expr, i); if (TREE_CODE (arg) == CONSTRUCTOR && TREE_CONSTANT (arg) @@ -8751,7 +8975,7 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, if (TREE_CODE (t) == ADDR_EXPR) t = TREE_OPERAND (t, 0); if (TREE_CODE (t) != STRING_CST) - *(CALL_EXPR_ARGP (expr) + i) = tree_output_constant_def (arg); + CALL_EXPR_ARG (expr, i) = tree_output_constant_def (arg); } } break; @@ -8816,11 +9040,21 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, TREE_NO_WARNING (expr) = TREE_NO_WARNING (op); break; - case UNCONSTRAINED_ARRAY_REF: - /* We should only do this if we are just elaborating for side effects, - but we can't know that yet. */ - *expr_p = TREE_OPERAND (*expr_p, 0); - return GS_OK; + case LOAD_EXPR: + { + tree new_var = create_tmp_var (type, "L"); + TREE_ADDRESSABLE (new_var) = 1; + + tree init = TREE_OPERAND (expr, 1); + gcc_assert (TREE_CODE (init) == CALL_EXPR); + tree arg = CALL_EXPR_ARG (init, 1); + CALL_EXPR_ARG (init, 1) + = build_unary_op (ADDR_EXPR, TREE_TYPE (arg), new_var); + gimplify_and_add (init, pre_p); + + *expr_p = new_var; + return GS_OK; + } case VIEW_CONVERT_EXPR: op = TREE_OPERAND (expr, 0); @@ -8832,10 +9066,10 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, && AGGREGATE_TYPE_P (TREE_TYPE (op)) && !AGGREGATE_TYPE_P (type)) { - tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C"); + tree new_var = create_tmp_var_raw (TREE_TYPE (op), "C"); gimple_add_tmp_var (new_var); - mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op); + tree mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op); gimplify_and_add (mod, pre_p); TREE_OPERAND (expr, 0) = new_var; @@ -8843,6 +9077,12 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, } break; + case UNCONSTRAINED_ARRAY_REF: + /* We should only do this if we are just elaborating for side effects, + but we can't know that yet. */ + *expr_p = TREE_OPERAND (expr, 0); + return GS_OK; + default: break; } |