diff options
Diffstat (limited to 'gcc/ada/trans.c')
| -rw-r--r-- | gcc/ada/trans.c | 466 |
1 files changed, 285 insertions, 181 deletions
diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index c22c192da08..eb25be383f9 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -779,8 +779,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) if (attribute == Attr_Max_Size_In_Storage_Elements) gnu_result = convert (sizetype, - fold (build (CEIL_DIV_EXPR, bitsizetype, - gnu_result, bitsize_unit_node))); + fold (build2 (CEIL_DIV_EXPR, bitsizetype, + gnu_result, bitsize_unit_node))); break; case Attr_Alignment: @@ -1101,8 +1101,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) example in AARM 11.6(5.e). */ if (prefix_unused && TREE_SIDE_EFFECTS (gnu_prefix) && !Is_Entity_Name (Prefix (gnat_node))) - gnu_result = fold (build (COMPOUND_EXPR, TREE_TYPE (gnu_result), - gnu_prefix, gnu_result)); + gnu_result = fold (build2 (COMPOUND_EXPR, TREE_TYPE (gnu_result), + gnu_prefix, gnu_result)); *gnu_result_type_p = gnu_result_type; return gnu_result; @@ -1197,9 +1197,9 @@ Case_Statement_to_gnu (Node_Id gnat_node) abort (); } - add_stmt_with_node (build (CASE_LABEL_EXPR, void_type_node, - gnu_low, gnu_high, - create_artificial_label ()), + add_stmt_with_node (build3 (CASE_LABEL_EXPR, void_type_node, + gnu_low, gnu_high, + create_artificial_label ()), gnat_choice); } @@ -1214,8 +1214,8 @@ Case_Statement_to_gnu (Node_Id gnat_node) /* Now emit a definition of the label all the cases branched to. */ add_stmt (build1 (LABEL_EXPR, void_type_node, TREE_VALUE (gnu_switch_label_stack))); - gnu_result = build (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr, - end_stmt_group (), NULL_TREE); + gnu_result = build3 (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr, + end_stmt_group (), NULL_TREE); pop_stack (&gnu_switch_label_stack); return gnu_result; @@ -1279,10 +1279,10 @@ Loop_Statement_to_gnu (Node_Id gnat_node) || tree_int_cst_equal (gnu_last, gnu_limit)) { gnu_cond_expr - = build (COND_EXPR, void_type_node, - build_binary_op (LE_EXPR, integer_type_node, - gnu_low, gnu_high), - NULL_TREE, alloc_stmt_list ()); + = build3 (COND_EXPR, void_type_node, + build_binary_op (LE_EXPR, integer_type_node, + gnu_low, gnu_high), + NULL_TREE, alloc_stmt_list ()); annotate_with_node (gnu_cond_expr, gnat_loop_spec); } @@ -1485,8 +1485,8 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) add_stmt_with_node (build1 (RETURN_EXPR, void_type_node, - build (MODIFY_EXPR, TREE_TYPE (gnu_retval), - DECL_RESULT (current_function_decl), gnu_retval)), + build2 (MODIFY_EXPR, TREE_TYPE (gnu_retval), + DECL_RESULT (current_function_decl), gnu_retval)), gnat_node); gnat_poplevel (); gnu_result = end_stmt_group (); @@ -1520,10 +1520,12 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) /* Subroutine of gnat_to_gnu to translate gnat_node, either an N_Function_Call or an N_Procedure_Call_Statement, to a GCC tree, which is returned. - GNU_RESULT_TYPE_P is a pointer to where we should place the result type. */ + GNU_RESULT_TYPE_P is a pointer to where we should place the result type. + If GNU_TARGET is non-null, this must be a function call and the result + of the call is to be placed into that object. */ static tree -call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) +call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) { tree gnu_result; /* The GCC node corresponding to the GNAT subprogram name. This can either @@ -1566,7 +1568,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) gnat_actual = Next_Actual (gnat_actual)) add_stmt (gnat_to_gnu (gnat_actual)); - if (Nkind (gnat_node) == N_Function_Call) + if (Nkind (gnat_node) == N_Function_Call && !gnu_target) { *gnu_result_type_p = TREE_TYPE (gnu_subprog_type); return build1 (NULL_EXPR, *gnu_result_type_p, @@ -1576,6 +1578,37 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) return build_call_raise (PE_Stubbed_Subprogram_Called); } + /* If we are calling by supplying a pointer to a target, set up that + pointer as the first argument. Use GNU_TARGET if one was passed; + otherwise, make a target by building a variable of the maximum size + of the type. */ + if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type)) + { + tree gnu_real_ret_type + = TREE_TYPE (TREE_VALUE (TYPE_ARG_TYPES (gnu_subprog_type))); + + if (!gnu_target) + { + tree gnu_obj_type + = maybe_pad_type (gnu_real_ret_type, + max_size (TYPE_SIZE (gnu_real_ret_type), true), + 0, Etype (Name (gnat_node)), "PAD", false, + false, false); + + gnu_target = create_tmp_var_raw (gnu_obj_type, "LR"); + gnat_pushdecl (gnu_target, gnat_node); + } + + gnu_actual_list + = tree_cons (NULL_TREE, + build_unary_op (ADDR_EXPR, NULL_TREE, + unchecked_convert (gnu_real_ret_type, + gnu_target, + false)), + NULL_TREE); + + } + /* The only way we can be making a call via an access type is if Name is an explicit dereference. In that case, get the list of formal args from the type the access type is pointing to. Otherwise, get the formals from @@ -1660,8 +1693,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) } /* Set up to move the copy back to the original. */ - gnu_temp = build (MODIFY_EXPR, TREE_TYPE (gnu_copy), - gnu_copy, gnu_actual); + gnu_temp = build2 (MODIFY_EXPR, TREE_TYPE (gnu_copy), + gnu_copy, gnu_actual); annotate_with_node (gnu_temp, gnat_actual); append_to_statement_list (gnu_temp, &gnu_after_list); } @@ -1826,12 +1859,24 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) gnu_actual_list = tree_cons (NULL_TREE, gnu_actual, gnu_actual_list); } - gnu_subprog_call = build (CALL_EXPR, TREE_TYPE (gnu_subprog_type), - gnu_subprog_addr, nreverse (gnu_actual_list), - NULL_TREE); + gnu_subprog_call = build3 (CALL_EXPR, TREE_TYPE (gnu_subprog_type), + gnu_subprog_addr, nreverse (gnu_actual_list), + NULL_TREE); - /* If it is a function call, the result is the call expression. */ - if (Nkind (gnat_node) == N_Function_Call) + /* If we return by passing a target, we emit the call and return the target + as our result. */ + if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type)) + { + add_stmt_with_node (gnu_subprog_call, gnat_node); + *gnu_result_type_p + = TREE_TYPE (TREE_VALUE (TYPE_ARG_TYPES (gnu_subprog_type))); + return unchecked_convert (*gnu_result_type_p, gnu_target, false); + } + + /* If it is a function call, the result is the call expression unless + a target is specified, in which case we copy the result into the target + and return the assignment statement. */ + else if (Nkind (gnat_node) == N_Function_Call) { gnu_result = gnu_subprog_call; @@ -1841,7 +1886,12 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) || TYPE_RETURNS_BY_REF_P (gnu_subprog_type)) gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result); - *gnu_result_type_p = get_unpadded_type (Etype (gnat_node)); + if (gnu_target) + gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE, + gnu_target, gnu_result); + else + *gnu_result_type_p = get_unpadded_type (Etype (gnat_node)); + return gnu_result; } @@ -2111,12 +2161,12 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) gnu_handler = end_stmt_group (); /* This block is now "if (setjmp) ... <handlers> else <block>". */ - gnu_result = build (COND_EXPR, void_type_node, - (build_call_1_expr - (setjmp_decl, - build_unary_op (ADDR_EXPR, NULL_TREE, - gnu_jmpbuf_decl))), - gnu_handler, gnu_inner_block); + gnu_result = build3 (COND_EXPR, void_type_node, + (build_call_1_expr + (setjmp_decl, + build_unary_op (ADDR_EXPR, NULL_TREE, + gnu_jmpbuf_decl))), + gnu_handler, gnu_inner_block); } else if (gcc_zcx) { @@ -2131,8 +2181,8 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) gnu_handlers = end_stmt_group (); /* Now make the TRY_CATCH_EXPR for the block. */ - gnu_result = build (TRY_CATCH_EXPR, void_type_node, - gnu_inner_block, gnu_handlers); + gnu_result = build2 (TRY_CATCH_EXPR, void_type_node, + gnu_inner_block, gnu_handlers); } else gnu_result = gnu_inner_block; @@ -2225,7 +2275,7 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node) gnu_choice, this_choice); } - return build (COND_EXPR, void_type_node, gnu_choice, gnu_body, NULL_TREE); + return build3 (COND_EXPR, void_type_node, gnu_choice, gnu_body, NULL_TREE); } /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Exception_Handler, @@ -2312,7 +2362,7 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node) We use a local variable to retrieve the incoming value at handler entry time, and reuse it to feed the end_handler hook's argument at exit. */ - gnu_current_exc_ptr = build (EXC_PTR_EXPR, ptr_type_node); + gnu_current_exc_ptr = build0 (EXC_PTR_EXPR, ptr_type_node); gnu_incoming_exc_ptr = create_var_decl (get_identifier ("EXPTR"), NULL_TREE, ptr_type_node, gnu_current_exc_ptr, false, false, false, false, NULL, @@ -2325,8 +2375,8 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node) add_stmt_list (Statements (gnat_node)); gnat_poplevel (); - return build (CATCH_EXPR, void_type_node, gnu_etypes_list, - end_stmt_group ()); + return build2 (CATCH_EXPR, void_type_node, gnu_etypes_list, + end_stmt_group ()); } /* Subroutine of gnat_to_gnu to generate code for an N_Compilation unit. */ @@ -2857,13 +2907,13 @@ gnat_to_gnu (Node_Id gnat_node) expression if the slice range is not null (max >= min) or returns the min if the slice range is null */ gnu_expr - = fold (build (COND_EXPR, gnu_expr_type, - build_binary_op (GE_EXPR, gnu_expr_type, - convert (gnu_expr_type, - gnu_max_expr), - convert (gnu_expr_type, - gnu_min_expr)), - gnu_expr, gnu_min_expr)); + = fold (build3 (COND_EXPR, gnu_expr_type, + build_binary_op (GE_EXPR, gnu_expr_type, + convert (gnu_expr_type, + gnu_max_expr), + convert (gnu_expr_type, + gnu_min_expr)), + gnu_expr, gnu_min_expr)); } else gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type)); @@ -3354,26 +3404,32 @@ gnat_to_gnu (Node_Id gnat_node) case N_Assignment_Statement: /* Get the LHS and RHS of the statement and convert any reference to an - unconstrained array into a reference to the underlying array. */ + unconstrained array into a reference to the underlying array. + If we are not to do range checking and the RHS is an N_Function_Call, + pass the LHS to the call function. */ gnu_lhs = maybe_unconstrained_array (gnat_to_gnu (Name (gnat_node))); - gnu_rhs - = maybe_unconstrained_array (gnat_to_gnu (Expression (gnat_node))); - - /* If range check is needed, emit code to generate it */ - if (Do_Range_Check (Expression (gnat_node))) - gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node))); - /* If either side's type has a size that overflows, convert this - into raise of Storage_Error: execution shouldn't have gotten - here anyway. */ - if ((TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_lhs))) == INTEGER_CST + /* If the type has a size that overflows, convert this into raise of + Storage_Error: execution shouldn't have gotten here anyway. */ + if (TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_lhs))) == INTEGER_CST && TREE_OVERFLOW (TYPE_SIZE (TREE_TYPE (gnu_lhs)))) - || (TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_rhs))) == INTEGER_CST - && TREE_OVERFLOW (TYPE_SIZE (TREE_TYPE (gnu_rhs))))) gnu_result = build_call_raise (SE_Object_Too_Large); + else if (Nkind (Expression (gnat_node)) == N_Function_Call + && !Do_Range_Check (Expression (gnat_node))) + gnu_result = call_to_gnu (Expression (gnat_node), + &gnu_result_type, gnu_lhs); else - gnu_result - = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs); + { + gnu_rhs + = maybe_unconstrained_array (gnat_to_gnu (Expression (gnat_node))); + + /* If range check is needed, emit code to generate it */ + if (Do_Range_Check (Expression (gnat_node))) + gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node))); + + gnu_result + = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs); + } break; case N_If_Statement: @@ -3381,9 +3437,9 @@ gnat_to_gnu (Node_Id gnat_node) tree *gnu_else_ptr; /* Point to put next "else if" or "else". */ /* Make the outer COND_EXPR. Avoid non-determinism. */ - gnu_result = build (COND_EXPR, void_type_node, - gnat_to_gnu (Condition (gnat_node)), - NULL_TREE, NULL_TREE); + gnu_result = build3 (COND_EXPR, void_type_node, + gnat_to_gnu (Condition (gnat_node)), + NULL_TREE, NULL_TREE); COND_EXPR_THEN (gnu_result) = build_stmt_group (Then_Statements (gnat_node), false); TREE_SIDE_EFFECTS (gnu_result) = 1; @@ -3396,9 +3452,9 @@ gnat_to_gnu (Node_Id gnat_node) for (gnat_temp = First (Elsif_Parts (gnat_node)); Present (gnat_temp); gnat_temp = Next (gnat_temp)) { - gnu_expr = build (COND_EXPR, void_type_node, - gnat_to_gnu (Condition (gnat_temp)), - NULL_TREE, NULL_TREE); + gnu_expr = build3 (COND_EXPR, void_type_node, + gnat_to_gnu (Condition (gnat_temp)), + NULL_TREE, NULL_TREE); COND_EXPR_THEN (gnu_expr) = build_stmt_group (Then_Statements (gnat_temp), false); TREE_SIDE_EFFECTS (gnu_expr) = 1; @@ -3433,12 +3489,12 @@ gnat_to_gnu (Node_Id gnat_node) case N_Exit_Statement: gnu_result - = build (EXIT_STMT, void_type_node, - (Present (Condition (gnat_node)) - ? gnat_to_gnu (Condition (gnat_node)) : NULL_TREE), - (Present (Name (gnat_node)) - ? get_gnu_tree (Entity (Name (gnat_node))) - : TREE_VALUE (gnu_loop_label_stack))); + = build2 (EXIT_STMT, void_type_node, + (Present (Condition (gnat_node)) + ? gnat_to_gnu (Condition (gnat_node)) : NULL_TREE), + (Present (Name (gnat_node)) + ? get_gnu_tree (Entity (Name (gnat_node))) + : TREE_VALUE (gnu_loop_label_stack))); break; case N_Return_Statement: @@ -3446,7 +3502,13 @@ gnat_to_gnu (Node_Id gnat_node) /* The gnu function type of the subprogram currently processed. */ tree gnu_subprog_type = TREE_TYPE (current_function_decl); /* The return value from the subprogram. */ - tree gnu_ret_val = 0; + tree gnu_ret_val = NULL_TREE; + /* The place to put the return value. */ + tree gnu_lhs + = (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type) + ? build_unary_op (INDIRECT_REF, NULL_TREE, + DECL_ARGUMENTS (current_function_decl)) + : DECL_RESULT (current_function_decl)); /* If we are dealing with a "return;" from an Ada procedure with parameters passed by copy in copy out, we need to return a record @@ -3484,53 +3546,71 @@ gnat_to_gnu (Node_Id gnat_node) else if (Present (Expression (gnat_node))) { - gnu_ret_val = gnat_to_gnu (Expression (gnat_node)); - - /* Do not remove the padding from GNU_RET_VAL if the inner - type is self-referential since we want to allocate the fixed - size in that case. */ - if (TREE_CODE (gnu_ret_val) == COMPONENT_REF - && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0))) - == RECORD_TYPE) - && (TYPE_IS_PADDING_P - (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0)))) - && (CONTAINS_PLACEHOLDER_P - (TYPE_SIZE (TREE_TYPE (gnu_ret_val))))) - gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0); - - if (TYPE_RETURNS_BY_REF_P (gnu_subprog_type) - || By_Ref (gnat_node)) - gnu_ret_val = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val); - - else if (TYPE_RETURNS_UNCONSTRAINED_P (gnu_subprog_type)) + /* If the current function returns by target pointer and we + are doing a call, pass that target to the call. */ + if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type) + && Nkind (Expression (gnat_node)) == N_Function_Call) + gnu_result = call_to_gnu (Expression (gnat_node), + &gnu_result_type, gnu_lhs); + + else { - gnu_ret_val = maybe_unconstrained_array (gnu_ret_val); - - /* We have two cases: either the function returns with - depressed stack or not. If not, we allocate on the - secondary stack. If so, we allocate in the stack frame. - if no copy is needed, the front end will set By_Ref, - which we handle in the case above. */ - if (TYPE_RETURNS_STACK_DEPRESSED (gnu_subprog_type)) - gnu_ret_val - = build_allocator (TREE_TYPE (gnu_ret_val), gnu_ret_val, - TREE_TYPE (gnu_subprog_type), 0, -1, - gnat_node); - else + gnu_ret_val = gnat_to_gnu (Expression (gnat_node)); + + /* Do not remove the padding from GNU_RET_VAL if the inner + type is self-referential since we want to allocate the fixed + size in that case. */ + if (TREE_CODE (gnu_ret_val) == COMPONENT_REF + && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0))) + == RECORD_TYPE) + && (TYPE_IS_PADDING_P + (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0)))) + && (CONTAINS_PLACEHOLDER_P + (TYPE_SIZE (TREE_TYPE (gnu_ret_val))))) + gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0); + + if (TYPE_RETURNS_BY_REF_P (gnu_subprog_type) + || By_Ref (gnat_node)) gnu_ret_val - = build_allocator (TREE_TYPE (gnu_ret_val), gnu_ret_val, - TREE_TYPE (gnu_subprog_type), - Procedure_To_Call (gnat_node), - Storage_Pool (gnat_node), gnat_node); + = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val); + + else if (TYPE_RETURNS_UNCONSTRAINED_P (gnu_subprog_type)) + { + gnu_ret_val = maybe_unconstrained_array (gnu_ret_val); + + /* We have two cases: either the function returns with + depressed stack or not. If not, we allocate on the + secondary stack. If so, we allocate in the stack frame. + if no copy is needed, the front end will set By_Ref, + which we handle in the case above. */ + if (TYPE_RETURNS_STACK_DEPRESSED (gnu_subprog_type)) + gnu_ret_val + = build_allocator (TREE_TYPE (gnu_ret_val), + gnu_ret_val, + TREE_TYPE (gnu_subprog_type), + 0, -1, gnat_node); + else + gnu_ret_val + = build_allocator (TREE_TYPE (gnu_ret_val), + gnu_ret_val, + TREE_TYPE (gnu_subprog_type), + Procedure_To_Call (gnat_node), + Storage_Pool (gnat_node), + gnat_node); + } + } + + gnu_result = build2 (MODIFY_EXPR, TREE_TYPE (gnu_ret_val), + gnu_lhs, gnu_ret_val); + if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type)) + { + add_stmt_with_node (gnu_result, gnat_node); + gnu_ret_val = NULL_TREE; } } gnu_result = build1 (RETURN_EXPR, void_type_node, - (gnu_ret_val - ? build (MODIFY_EXPR, TREE_TYPE (gnu_ret_val), - DECL_RESULT (current_function_decl), - gnu_ret_val) - : NULL_TREE)); + gnu_ret_val ? gnu_result : gnu_ret_val); } break; @@ -3584,7 +3664,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); + gnu_result = call_to_gnu (gnat_node, &gnu_result_type, NULL_TREE); break; /*************************/ @@ -3788,9 +3868,9 @@ gnat_to_gnu (Node_Id gnat_node) gnu_input_list = nreverse (gnu_input_list); gnu_output_list = nreverse (gnu_output_list); - gnu_result = build (ASM_EXPR, void_type_node, - gnu_template, gnu_output_list, - gnu_input_list, gnu_clobber_list); + gnu_result = build4 (ASM_EXPR, void_type_node, + gnu_template, gnu_output_list, + gnu_input_list, gnu_clobber_list); ASM_VOLATILE_P (gnu_result) = Is_Asm_Volatile (gnat_node); } else @@ -3889,9 +3969,9 @@ gnat_to_gnu (Node_Id gnat_node) annotate_with_node (gnu_result, gnat_node); if (Present (Condition (gnat_node))) - gnu_result = build (COND_EXPR, void_type_node, - gnat_to_gnu (Condition (gnat_node)), - gnu_result, alloc_stmt_list ()); + gnu_result = build3 (COND_EXPR, void_type_node, + gnat_to_gnu (Condition (gnat_node)), + gnu_result, alloc_stmt_list ()); } else gnu_result = build1 (NULL_EXPR, gnu_result_type, gnu_result); @@ -4079,7 +4159,7 @@ gnat_to_gnu (Node_Id gnat_node) static void record_code_position (Node_Id gnat_node) { - tree stmt_stmt = build (STMT_STMT, void_type_node, NULL_TREE); + tree stmt_stmt = build1 (STMT_STMT, void_type_node, NULL_TREE); add_stmt_with_node (stmt_stmt, gnat_node); save_gnu_tree (gnat_node, stmt_stmt, true); @@ -4157,7 +4237,7 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) this decl since we already have evaluated the expressions in the sizes and positions as globals and doing it again would be wrong. But we do have to mark everything as used. */ - gnu_stmt = build (DECL_EXPR, void_type_node, gnu_decl); + gnu_stmt = build1 (DECL_EXPR, void_type_node, gnu_decl); if (!global_bindings_p ()) add_stmt_with_node (gnu_stmt, gnat_entity); else @@ -4276,12 +4356,12 @@ end_stmt_group () gnu_retval = alloc_stmt_list (); if (group->cleanups) - gnu_retval = build (TRY_FINALLY_EXPR, void_type_node, gnu_retval, - group->cleanups); + gnu_retval = build2 (TRY_FINALLY_EXPR, void_type_node, gnu_retval, + group->cleanups); if (current_stmt_group->block) - gnu_retval = build (BIND_EXPR, void_type_node, BLOCK_VARS (group->block), - gnu_retval, group->block); + gnu_retval = build3 (BIND_EXPR, void_type_node, BLOCK_VARS (group->block), + gnu_retval, group->block); /* Remove this group from the stack and add it to the free list. */ current_stmt_group = group->previous; @@ -4418,10 +4498,33 @@ gnat_gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p ATTRIBUTE_UNUSED) *expr_p = TREE_OPERAND (*expr_p, 0); return GS_OK; + case ADDR_EXPR: + /* If we're taking the address of a constant CONSTRUCTOR, force it to + be put into static memory. We know it's going to be readonly given + the semantics we have and it's required to be static memory in + the case when the reference is in an elaboration procedure. */ + if (TREE_CODE (TREE_OPERAND (expr, 0)) == CONSTRUCTOR + && TREE_CONSTANT (TREE_OPERAND (expr, 0))) + { + tree new_var + = create_tmp_var (TREE_TYPE (TREE_OPERAND (expr, 0)), "C"); + + TREE_READONLY (new_var) = 1; + TREE_STATIC (new_var) = 1; + TREE_ADDRESSABLE (new_var) = 1; + + gimplify_and_add (build2 (MODIFY_EXPR, TREE_TYPE (new_var), + new_var, TREE_OPERAND (expr, 0)), + pre_p); + + TREE_OPERAND (expr, 0) = new_var; + return GS_ALL_DONE; + } + return GS_UNHANDLED; + case COMPONENT_REF: - /* We have a kludge here. If the FIELD_DECL is from a fat pointer - and is from an early dummy type, replace it with the proper - FIELD_DECL. */ + /* We have a kludge here. If the FIELD_DECL is from a fat pointer and is + from an early dummy type, replace it with the proper FIELD_DECL. */ if (TYPE_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (*expr_p, 0))) && DECL_ORIGINAL_FIELD (TREE_OPERAND (*expr_p, 1))) { @@ -4472,23 +4575,23 @@ gnat_gimplify_stmt (tree *stmt_p) stmt_p); if (LOOP_STMT_TOP_COND (stmt)) - append_to_statement_list (build (COND_EXPR, void_type_node, - LOOP_STMT_TOP_COND (stmt), - alloc_stmt_list (), - build1 (GOTO_EXPR, - void_type_node, - gnu_end_label)), + append_to_statement_list (build3 (COND_EXPR, void_type_node, + LOOP_STMT_TOP_COND (stmt), + alloc_stmt_list (), + build1 (GOTO_EXPR, + void_type_node, + gnu_end_label)), stmt_p); append_to_statement_list (LOOP_STMT_BODY (stmt), stmt_p); if (LOOP_STMT_BOT_COND (stmt)) - append_to_statement_list (build (COND_EXPR, void_type_node, - LOOP_STMT_BOT_COND (stmt), - alloc_stmt_list (), - build1 (GOTO_EXPR, - void_type_node, - gnu_end_label)), + append_to_statement_list (build3 (COND_EXPR, void_type_node, + LOOP_STMT_BOT_COND (stmt), + alloc_stmt_list (), + build1 (GOTO_EXPR, + void_type_node, + gnu_end_label)), stmt_p); if (LOOP_STMT_UPDATE (stmt)) @@ -4508,8 +4611,8 @@ gnat_gimplify_stmt (tree *stmt_p) see if it needs to be conditional. */ *stmt_p = build1 (GOTO_EXPR, void_type_node, EXIT_STMT_LABEL (stmt)); if (EXIT_STMT_COND (stmt)) - *stmt_p = build (COND_EXPR, void_type_node, - EXIT_STMT_COND (stmt), *stmt_p, alloc_stmt_list ()); + *stmt_p = build3 (COND_EXPR, void_type_node, + EXIT_STMT_COND (stmt), *stmt_p, alloc_stmt_list ()); return GS_OK; default: @@ -4974,17 +5077,17 @@ emit_check (tree gnu_cond, tree gnu_expr, int reason) in front of the comparison in case it ends up being a SAVE_EXPR. Put the whole thing inside its own SAVE_EXPR so the inner SAVE_EXPR doesn't leak out. */ - gnu_result = fold (build (COND_EXPR, TREE_TYPE (gnu_expr), gnu_cond, - build (COMPOUND_EXPR, TREE_TYPE (gnu_expr), - gnu_call, gnu_expr), - gnu_expr)); + gnu_result = fold (build3 (COND_EXPR, TREE_TYPE (gnu_expr), gnu_cond, + build2 (COMPOUND_EXPR, TREE_TYPE (gnu_expr), + gnu_call, gnu_expr), + gnu_expr)); /* If GNU_EXPR has side effects, make the outer COMPOUND_EXPR and protect it. Otherwise, show GNU_RESULT has no side effects: we don't need to evaluate it just for the check. */ if (TREE_SIDE_EFFECTS (gnu_expr)) gnu_result - = build (COMPOUND_EXPR, TREE_TYPE (gnu_expr), gnu_expr, gnu_result); + = build2 (COMPOUND_EXPR, TREE_TYPE (gnu_expr), gnu_expr, gnu_result); else TREE_SIDE_EFFECTS (gnu_result) = 0; @@ -5107,13 +5210,13 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp, tree gnu_minus_point_5 = build_real (gnu_in_basetype, dconstmp5); tree gnu_zero = convert (gnu_in_basetype, integer_zero_node); tree gnu_saved_result = save_expr (gnu_result); - tree gnu_comp = build (GE_EXPR, integer_type_node, - gnu_saved_result, gnu_zero); - tree gnu_adjust = build (COND_EXPR, gnu_in_basetype, gnu_comp, - gnu_point_5, gnu_minus_point_5); + tree gnu_comp = build2 (GE_EXPR, integer_type_node, + gnu_saved_result, gnu_zero); + tree gnu_adjust = build3 (COND_EXPR, gnu_in_basetype, gnu_comp, + gnu_point_5, gnu_minus_point_5); gnu_result - = build (PLUS_EXPR, gnu_in_basetype, gnu_saved_result, gnu_adjust); + = build2 (PLUS_EXPR, gnu_in_basetype, gnu_saved_result, gnu_adjust); } if (TREE_CODE (gnu_ada_base_type) == INTEGER_TYPE @@ -5531,36 +5634,36 @@ gnat_stabilize_reference (tree ref, bool force) break; case COMPONENT_REF: - result = build (COMPONENT_REF, type, - gnat_stabilize_reference (TREE_OPERAND (ref, 0), - force), - TREE_OPERAND (ref, 1), NULL_TREE); + result = build3 (COMPONENT_REF, type, + gnat_stabilize_reference (TREE_OPERAND (ref, 0), + force), + TREE_OPERAND (ref, 1), NULL_TREE); break; case BIT_FIELD_REF: - result = build (BIT_FIELD_REF, type, - gnat_stabilize_reference (TREE_OPERAND (ref, 0), force), - gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1), - force), - gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2), - force)); + result = build3 (BIT_FIELD_REF, type, + gnat_stabilize_reference (TREE_OPERAND (ref, 0), force), + gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1), + force), + gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2), + force)); break; case ARRAY_REF: case ARRAY_RANGE_REF: - result = build (code, type, - gnat_stabilize_reference (TREE_OPERAND (ref, 0), force), - gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1), - force), - NULL_TREE, NULL_TREE); + result = build4 (code, type, + gnat_stabilize_reference (TREE_OPERAND (ref, 0), force), + gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1), + force), + NULL_TREE, NULL_TREE); break; case COMPOUND_EXPR: - result = build (COMPOUND_EXPR, type, - gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0), - force), - gnat_stabilize_reference (TREE_OPERAND (ref, 1), - force)); + result = build2 (COMPOUND_EXPR, type, + gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0), + force), + gnat_stabilize_reference (TREE_OPERAND (ref, 1), + force)); break; /* If arg isn't a kind of lvalue we recognize, make no change. @@ -5621,10 +5724,10 @@ gnat_stabilize_reference_1 (tree e, bool force) us to more easily find the match for the PLACEHOLDER_EXPR. */ if (code == COMPONENT_REF && TYPE_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0)))) - result = build (COMPONENT_REF, type, - gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), - force), - TREE_OPERAND (e, 1), TREE_OPERAND (e, 2)); + result = build3 (COMPONENT_REF, type, + gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), + force), + TREE_OPERAND (e, 1), TREE_OPERAND (e, 2)); else if (TREE_SIDE_EFFECTS (e) || force) return save_expr (e); else @@ -5638,9 +5741,10 @@ gnat_stabilize_reference_1 (tree e, bool force) case '2': /* Recursively stabilize each operand. */ - result = build (code, type, - gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force), - gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force)); + result = build2 (code, type, + gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force), + gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), + force)); break; case '1': |