revised PATCH: CALL_EXPR representation changes, part 9/9 (Fortran front end)
Paul Thomas
paulthomas2@wanadoo.fr
Wed Feb 14 21:16:00 GMT 2007
Sandra,
It looks a good sight neater!
OK
Thanks
Paul
PS - I found the version of 10 minutes previously far easier to review :-)
> ------------------------------------------------------------------------
>
> 2007-02-14 Sandra Loosemore <sandra@codesourcery.com>
> Brooks Moses <brooks.moses@codesourcery.com>
> Lee Millward <lee.millward@codesourcery.com>
>
> * trans-expr.c (gfc_conv_power_op): Use build_call_expr.
> (gfc_conv_string_tmp): Likewise.
> (gfc_conv_concat_op): Likewise.
> (gfc_build_compare_string): Likewise.
> (gfc_conv_function_call): Use build_call_list instead of build3.
>
> * trans-array.c (gfc_trans_allocate_array_storage): Use
> build_call_expr.
> (gfc_grow_array): Likewise.
> (gfc_trans_array_ctor_element): Likewise.
> (gfc_trans_array_constructor_value): Likewise.
> (gfc_array_allocate): Likewise.
> (gfc_array_deallocate): Likewise.
> (gfc_trans_auto_array_allocation): Likewise.
> (gfc_trans_dummy_array_bias): Likewise.
> (gfc_conv_array_parameter): Likewise.
> (gfc_trans_dealloc_allocated): Likewise.
> (gfc_duplicate_allocatable): Likewise.
>
> * trans-openmp.c (gfc_trans_omp_barrier): Use build_call_expr.
> (gfc_trans_omp_flush): Likewise.
>
> * trans-stmt.c (gfc_conv_elementel_dependencies): Use build_call_expr.
> (gfc_trans_pause): Likewise.
> (gfc_trans_stop): Likewise.
> (gfc_trans_character_select): Likewise.
> (gfc_do_allocate): Likewise.
> (gfc_trans_assign_need_temp): Likewise.
> (gfc_trans_pointer_assign_need_temp): Likewise.
> (gfc_trans_forall_1): Likewise.
> (gfc_trans_where_2): Likewise.
> (gfc_trans_allocate): Likewise.
> (gfc_trans_deallocate): Likewise.
>
> * trans.c (gfc_trans_runtime_check): Use build_call_expr.
>
> * trans-io.c (gfc_trans_open): Use build_call_expr.
> (gfc_trans_close): Likewise.
> (build_filepos): Likewise.
> (gfc_trans_inquire): Likewise.
> (NML_FIRST_ARG): Delete.
> (NML_ADD_ARG): Delete.
> (transfer_namelist_element): Use build_call_expr.
> (build_dt): Likewise.
> (gfc_trans_dt_end): Likewise.
> (transfer_expr): Likewise.
> (transfer_array-desc): Likewise.
>
> * trans-decl.c (gfc_generate_function_code): Use build_call_expr.
> (gfc_generate_constructors): Likewise.
>
> * trans-intrinsic.c (gfc_conv_intrinsic_ctime): Use build_call_expr.
> (gfc_conv_intrinsic_fdate): Likewise.
> (gfc_conv_intrinsic_ttynam): Likewise.
> (gfc_conv_intrinsic_array_transfer): Likewise.
> (gfc_conv_associated): Likewise.
> (gfc_conv_intrinsic_si_kind): Likewise.
> (gfc_conv_intrinsic_trim): Likewise.
> (gfc_conv_intrinsic_repeat: Likewise.
> (gfc_conv_intrinsic_iargc): Likewise.
>
> ------------------------------------------------------------------------
>
> Index: gcc/fortran/trans-expr.c
> ===================================================================
> *** gcc/fortran/trans-expr.c (revision 121818)
> --- gcc/fortran/trans-expr.c (working copy)
> *************** gfc_conv_power_op (gfc_se * se, gfc_expr
> *** 748,754 ****
> gfc_se lse;
> gfc_se rse;
> tree fndecl;
> - tree tmp;
>
> gfc_init_se (&lse, se);
> gfc_conv_expr_val (&lse, expr->value.op.op1);
> --- 748,753 ----
> *************** gfc_conv_power_op (gfc_se * se, gfc_expr
> *** 887,895 ****
> break;
> }
>
> ! tmp = gfc_chainon_list (NULL_TREE, lse.expr);
> ! tmp = gfc_chainon_list (tmp, rse.expr);
> ! se->expr = build_function_call_expr (fndecl, tmp);
> }
>
>
> --- 886,892 ----
> break;
> }
>
> ! se->expr = build_call_expr (fndecl, 2, lse.expr, rse.expr);
> }
>
>
> *************** gfc_conv_string_tmp (gfc_se * se, tree t
> *** 900,906 ****
> {
> tree var;
> tree tmp;
> - tree args;
>
> gcc_assert (TREE_TYPE (len) == gfc_charlen_type_node);
>
> --- 897,902 ----
> *************** gfc_conv_string_tmp (gfc_se * se, tree t
> *** 918,932 ****
> {
> /* Allocate a temporary to hold the result. */
> var = gfc_create_var (type, "pstr");
> ! args = gfc_chainon_list (NULL_TREE, len);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_malloc, args);
> tmp = convert (type, tmp);
> gfc_add_modify_expr (&se->pre, var, tmp);
>
> /* Free the temporary afterwards. */
> tmp = convert (pvoid_type_node, var);
> ! args = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, args);
> gfc_add_expr_to_block (&se->post, tmp);
> }
>
> --- 914,926 ----
> {
> /* Allocate a temporary to hold the result. */
> var = gfc_create_var (type, "pstr");
> ! tmp = build_call_expr (gfor_fndecl_internal_malloc, 1, len);
> tmp = convert (type, tmp);
> gfc_add_modify_expr (&se->pre, var, tmp);
>
> /* Free the temporary afterwards. */
> tmp = convert (pvoid_type_node, var);
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
> gfc_add_expr_to_block (&se->post, tmp);
> }
>
> *************** gfc_conv_concat_op (gfc_se * se, gfc_exp
> *** 945,951 ****
> tree len;
> tree type;
> tree var;
> - tree args;
> tree tmp;
>
> gcc_assert (expr->value.op.op1->ts.type == BT_CHARACTER
> --- 939,944 ----
> *************** gfc_conv_concat_op (gfc_se * se, gfc_exp
> *** 974,987 ****
> var = gfc_conv_string_tmp (se, type, len);
>
> /* Do the actual concatenation. */
> ! args = NULL_TREE;
> ! args = gfc_chainon_list (args, len);
> ! args = gfc_chainon_list (args, var);
> ! args = gfc_chainon_list (args, lse.string_length);
> ! args = gfc_chainon_list (args, lse.expr);
> ! args = gfc_chainon_list (args, rse.string_length);
> ! args = gfc_chainon_list (args, rse.expr);
> ! tmp = build_function_call_expr (gfor_fndecl_concat_string, args);
> gfc_add_expr_to_block (&se->pre, tmp);
>
> /* Add the cleanup for the operands. */
> --- 967,976 ----
> var = gfc_conv_string_tmp (se, type, len);
>
> /* Do the actual concatenation. */
> ! tmp = build_call_expr (gfor_fndecl_concat_string, 6,
> ! len, var,
> ! lse.string_length, lse.expr,
> ! rse.string_length, rse.expr);
> gfc_add_expr_to_block (&se->pre, tmp);
>
> /* Add the cleanup for the operands. */
> *************** gfc_build_compare_string (tree len1, tre
> *** 1205,1221 ****
> tmp = fold_build2 (MINUS_EXPR, type, sc1, sc2);
> }
> else
> ! {
> ! tmp = NULL_TREE;
> ! tmp = gfc_chainon_list (tmp, len1);
> ! tmp = gfc_chainon_list (tmp, str1);
> ! tmp = gfc_chainon_list (tmp, len2);
> ! tmp = gfc_chainon_list (tmp, str2);
> !
> ! /* Build a call for the comparison. */
> ! tmp = build_function_call_expr (gfor_fndecl_compare_string, tmp);
> ! }
> !
> return tmp;
> }
>
> --- 1194,1202 ----
> tmp = fold_build2 (MINUS_EXPR, type, sc1, sc2);
> }
> else
> ! /* Build a call for the comparison. */
> ! tmp = build_call_expr (gfor_fndecl_compare_string, 4,
> ! len1, str1, len2, str2);
> return tmp;
> }
>
> *************** gfc_conv_operator_assign (gfc_se *lse, g
> *** 1281,1287 ****
> gfc_init_se (&se, NULL);
> gfc_conv_function_val (&se, sym);
> tmp = TREE_TYPE (TREE_TYPE (TREE_TYPE (se.expr)));
> ! tmp = build3 (CALL_EXPR, tmp, se.expr, args, NULL_TREE);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &lse->post);
> --- 1262,1268 ----
> gfc_init_se (&se, NULL);
> gfc_conv_function_val (&se, sym);
> tmp = TREE_TYPE (TREE_TYPE (TREE_TYPE (se.expr)));
> ! tmp = build_call_list (tmp, se.expr, args);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &lse->post);
> *************** gfc_conv_function_call (gfc_se * se, gfc
> *** 2407,2414 ****
> }
>
> fntype = TREE_TYPE (TREE_TYPE (se->expr));
> ! se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
> ! arglist, NULL_TREE);
>
> /* If we have a pointer function, but we don't want a pointer, e.g.
> something like
> --- 2388,2394 ----
> }
>
> fntype = TREE_TYPE (TREE_TYPE (se->expr));
> ! se->expr = build_call_list (TREE_TYPE (fntype), se->expr, arglist);
>
> /* If we have a pointer function, but we don't want a pointer, e.g.
> something like
> *************** gfc_trans_string_copy (stmtblock_t * blo
> *** 2542,2567 ****
>
> /* Truncate string if source is too long. */
> cond2 = fold_build2 (GE_EXPR, boolean_type_node, slen, dlen);
> ! tmp2 = gfc_chainon_list (NULL_TREE, dest);
> ! tmp2 = gfc_chainon_list (tmp2, src);
> ! tmp2 = gfc_chainon_list (tmp2, dlen);
> ! tmp2 = build_function_call_expr (built_in_decls[BUILT_IN_MEMMOVE], tmp2);
>
> /* Else copy and pad with spaces. */
> ! tmp3 = gfc_chainon_list (NULL_TREE, dest);
> ! tmp3 = gfc_chainon_list (tmp3, src);
> ! tmp3 = gfc_chainon_list (tmp3, slen);
> ! tmp3 = build_function_call_expr (built_in_decls[BUILT_IN_MEMMOVE], tmp3);
>
> tmp4 = fold_build2 (PLUS_EXPR, pchar_type_node, dest,
> fold_convert (pchar_type_node, slen));
> ! tmp4 = gfc_chainon_list (NULL_TREE, tmp4);
> ! tmp4 = gfc_chainon_list (tmp4, build_int_cst
> ! (gfc_get_int_type (gfc_c_int_kind),
> ! lang_hooks.to_target_charset (' ')));
> ! tmp4 = gfc_chainon_list (tmp4, fold_build2 (MINUS_EXPR, TREE_TYPE(dlen),
> ! dlen, slen));
> ! tmp4 = build_function_call_expr (built_in_decls[BUILT_IN_MEMSET], tmp4);
>
> gfc_init_block (&tempblock);
> gfc_add_expr_to_block (&tempblock, tmp3);
> --- 2522,2542 ----
>
> /* Truncate string if source is too long. */
> cond2 = fold_build2 (GE_EXPR, boolean_type_node, slen, dlen);
> ! tmp2 = build_call_expr (built_in_decls[BUILT_IN_MEMMOVE],
> ! 3, dest, src, dlen);
>
> /* Else copy and pad with spaces. */
> ! tmp3 = build_call_expr (built_in_decls[BUILT_IN_MEMMOVE],
> ! 3, dest, src, slen);
>
> tmp4 = fold_build2 (PLUS_EXPR, pchar_type_node, dest,
> fold_convert (pchar_type_node, slen));
> ! tmp4 = build_call_expr (built_in_decls[BUILT_IN_MEMSET], 3,
> ! tmp4,
> ! build_int_cst (gfc_get_int_type (gfc_c_int_kind),
> ! lang_hooks.to_target_charset (' ')),
> ! fold_build2 (MINUS_EXPR, TREE_TYPE(dlen),
> ! dlen, slen));
>
> gfc_init_block (&tempblock);
> gfc_add_expr_to_block (&tempblock, tmp3);
> *************** static tree
> *** 3585,3591 ****
> gfc_trans_zero_assign (gfc_expr * expr)
> {
> tree dest, len, type;
> ! tree tmp, args;
> gfc_symbol *sym;
>
> sym = expr->symtree->n.sym;
> --- 3560,3566 ----
> gfc_trans_zero_assign (gfc_expr * expr)
> {
> tree dest, len, type;
> ! tree tmp;
> gfc_symbol *sym;
>
> sym = expr->symtree->n.sym;
> *************** gfc_trans_zero_assign (gfc_expr * expr)
> *** 3613,3622 ****
> len = fold_convert (size_type_node, len);
>
> /* Construct call to __builtin_memset. */
> ! args = build_tree_list (NULL_TREE, len);
> ! args = tree_cons (NULL_TREE, integer_zero_node, args);
> ! args = tree_cons (NULL_TREE, dest, args);
> ! tmp = build_function_call_expr (built_in_decls[BUILT_IN_MEMSET], args);
> return fold_convert (void_type_node, tmp);
> }
>
> --- 3588,3595 ----
> len = fold_convert (size_type_node, len);
>
> /* Construct call to __builtin_memset. */
> ! tmp = build_call_expr (built_in_decls[BUILT_IN_MEMSET],
> ! 3, dest, integer_zero_node, len);
> return fold_convert (void_type_node, tmp);
> }
>
> *************** gfc_trans_zero_assign (gfc_expr * expr)
> *** 3627,3633 ****
> static tree
> gfc_build_memcpy_call (tree dst, tree src, tree len)
> {
> ! tree tmp, args;
>
> /* Convert arguments to the correct types. */
> if (!POINTER_TYPE_P (TREE_TYPE (dst)))
> --- 3600,3606 ----
> static tree
> gfc_build_memcpy_call (tree dst, tree src, tree len)
> {
> ! tree tmp;
>
> /* Convert arguments to the correct types. */
> if (!POINTER_TYPE_P (TREE_TYPE (dst)))
> *************** gfc_build_memcpy_call (tree dst, tree sr
> *** 3643,3652 ****
> len = fold_convert (size_type_node, len);
>
> /* Construct call to __builtin_memcpy. */
> ! args = build_tree_list (NULL_TREE, len);
> ! args = tree_cons (NULL_TREE, src, args);
> ! args = tree_cons (NULL_TREE, dst, args);
> ! tmp = build_function_call_expr (built_in_decls[BUILT_IN_MEMCPY], args);
> return fold_convert (void_type_node, tmp);
> }
>
> --- 3616,3622 ----
> len = fold_convert (size_type_node, len);
>
> /* Construct call to __builtin_memcpy. */
> ! tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3, dst, src, len);
> return fold_convert (void_type_node, tmp);
> }
>
> Index: gcc/fortran/trans-array.c
> ===================================================================
> *** gcc/fortran/trans-array.c (revision 121818)
> --- gcc/fortran/trans-array.c (working copy)
> *************** gfc_trans_allocate_array_storage (stmtbl
> *** 501,507 ****
> bool dynamic, bool dealloc)
> {
> tree tmp;
> - tree args;
> tree desc;
> bool onstack;
>
> --- 501,506 ----
> *************** gfc_trans_allocate_array_storage (stmtbl
> *** 534,548 ****
> else
> {
> /* Allocate memory to hold the data. */
> - args = gfc_chainon_list (NULL_TREE, size);
> -
> if (gfc_index_integer_kind == 4)
> tmp = gfor_fndecl_internal_malloc;
> else if (gfc_index_integer_kind == 8)
> tmp = gfor_fndecl_internal_malloc64;
> else
> gcc_unreachable ();
> ! tmp = build_function_call_expr (tmp, args);
> tmp = gfc_evaluate_now (tmp, pre);
> gfc_conv_descriptor_data_set (pre, desc, tmp);
> }
> --- 533,545 ----
> else
> {
> /* Allocate memory to hold the data. */
> if (gfc_index_integer_kind == 4)
> tmp = gfor_fndecl_internal_malloc;
> else if (gfc_index_integer_kind == 8)
> tmp = gfor_fndecl_internal_malloc64;
> else
> gcc_unreachable ();
> ! tmp = build_call_expr (tmp, 1, size);
> tmp = gfc_evaluate_now (tmp, pre);
> gfc_conv_descriptor_data_set (pre, desc, tmp);
> }
> *************** gfc_trans_allocate_array_storage (stmtbl
> *** 559,566 ****
> /* Free the temporary. */
> tmp = gfc_conv_descriptor_data_get (desc);
> tmp = fold_convert (pvoid_type_node, tmp);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
> gfc_add_expr_to_block (post, tmp);
> }
> }
> --- 556,562 ----
> /* Free the temporary. */
> tmp = gfc_conv_descriptor_data_get (desc);
> tmp = fold_convert (pvoid_type_node, tmp);
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
> gfc_add_expr_to_block (post, tmp);
> }
> }
> *************** gfc_get_iteration_count (tree start, tre
> *** 829,835 ****
> static void
> gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
> {
> ! tree args;
> tree tmp;
> tree size;
> tree ubound;
> --- 825,831 ----
> static void
> gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
> {
> ! tree arg0, arg1;
> tree tmp;
> tree size;
> tree ubound;
> *************** gfc_grow_array (stmtblock_t * pblock, tr
> *** 844,857 ****
> gfc_add_modify_expr (pblock, ubound, tmp);
>
> /* Get the value of the current data pointer. */
> ! tmp = gfc_conv_descriptor_data_get (desc);
> ! args = gfc_chainon_list (NULL_TREE, tmp);
>
> /* Calculate the new array size. */
> size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
> tmp = build2 (PLUS_EXPR, gfc_array_index_type, ubound, gfc_index_one_node);
> ! tmp = build2 (MULT_EXPR, gfc_array_index_type, tmp, size);
> ! args = gfc_chainon_list (args, tmp);
>
> /* Pick the appropriate realloc function. */
> if (gfc_index_integer_kind == 4)
> --- 840,851 ----
> gfc_add_modify_expr (pblock, ubound, tmp);
>
> /* Get the value of the current data pointer. */
> ! arg0 = gfc_conv_descriptor_data_get (desc);
>
> /* Calculate the new array size. */
> size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
> tmp = build2 (PLUS_EXPR, gfc_array_index_type, ubound, gfc_index_one_node);
> ! arg1 = build2 (MULT_EXPR, gfc_array_index_type, tmp, size);
>
> /* Pick the appropriate realloc function. */
> if (gfc_index_integer_kind == 4)
> *************** gfc_grow_array (stmtblock_t * pblock, tr
> *** 862,868 ****
> gcc_unreachable ();
>
> /* Set the new data pointer. */
> ! tmp = build_function_call_expr (tmp, args);
> gfc_conv_descriptor_data_set (pblock, desc, tmp);
> }
>
> --- 856,862 ----
> gcc_unreachable ();
>
> /* Set the new data pointer. */
> ! tmp = build_call_expr (tmp, 2, arg0, arg1);
> gfc_conv_descriptor_data_set (pblock, desc, tmp);
> }
>
> *************** gfc_trans_array_ctor_element (stmtblock_
> *** 971,977 ****
> tree offset, gfc_se * se, gfc_expr * expr)
> {
> tree tmp;
> - tree args;
>
> gfc_conv_expr (se, expr);
>
> --- 965,970 ----
> *************** gfc_trans_array_ctor_element (stmtblock_
> *** 993,1003 ****
> tmp = gfc_build_addr_expr (pchar_type_node, tmp);
> /* We know the temporary and the value will be the same length,
> so can use memcpy. */
> ! args = gfc_chainon_list (NULL_TREE, tmp);
> ! args = gfc_chainon_list (args, se->expr);
> ! args = gfc_chainon_list (args, se->string_length);
> ! tmp = built_in_decls[BUILT_IN_MEMCPY];
> ! tmp = build_function_call_expr (tmp, args);
> gfc_add_expr_to_block (&se->pre, tmp);
> }
> }
> --- 986,993 ----
> tmp = gfc_build_addr_expr (pchar_type_node, tmp);
> /* We know the temporary and the value will be the same length,
> so can use memcpy. */
> ! tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3,
> ! tmp, se->expr, se->string_length);
> gfc_add_expr_to_block (&se->pre, tmp);
> }
> }
> *************** gfc_trans_array_constructor_value (stmtb
> *** 1206,1216 ****
>
> size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (type));
> bound = build_int_cst (NULL_TREE, n * size);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = gfc_chainon_list (tmp, init);
> ! tmp = gfc_chainon_list (tmp, bound);
> ! tmp = build_function_call_expr (built_in_decls[BUILT_IN_MEMCPY],
> ! tmp);
> gfc_add_expr_to_block (&body, tmp);
>
> *poffset = fold_build2 (PLUS_EXPR, gfc_array_index_type,
> --- 1196,1203 ----
>
> size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (type));
> bound = build_int_cst (NULL_TREE, n * size);
> ! tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3,
> ! tmp, init, bound);
> gfc_add_expr_to_block (&body, tmp);
>
> *poffset = fold_build2 (PLUS_EXPR, gfc_array_index_type,
> *************** gfc_array_allocate (gfc_se * se, gfc_exp
> *** 3491,3503 ****
> else
> gcc_unreachable ();
>
> - tmp = NULL_TREE;
> /* The allocate_array variants take the old pointer as first argument. */
> if (allocatable_array)
> ! tmp = gfc_chainon_list (tmp, pointer);
> ! tmp = gfc_chainon_list (tmp, size);
> ! tmp = gfc_chainon_list (tmp, pstat);
> ! tmp = build_function_call_expr (allocate, tmp);
> tmp = build2 (MODIFY_EXPR, void_type_node, pointer, tmp);
> gfc_add_expr_to_block (&se->pre, tmp);
>
> --- 3478,3488 ----
> else
> gcc_unreachable ();
>
> /* The allocate_array variants take the old pointer as first argument. */
> if (allocatable_array)
> ! tmp = build_call_expr (allocate, 3, pointer, size, pstat);
> ! else
> ! tmp = build_call_expr (allocate, 2, size, pstat);
> tmp = build2 (MODIFY_EXPR, void_type_node, pointer, tmp);
> gfc_add_expr_to_block (&se->pre, tmp);
>
> *************** gfc_array_deallocate (tree descriptor, t
> *** 3533,3541 ****
> STRIP_NOPS (var);
>
> /* Parameter is the address of the data component. */
> ! tmp = gfc_chainon_list (NULL_TREE, var);
> ! tmp = gfc_chainon_list (tmp, pstat);
> ! tmp = build_function_call_expr (gfor_fndecl_deallocate, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> /* Zero the data pointer. */
> --- 3518,3524 ----
> STRIP_NOPS (var);
>
> /* Parameter is the address of the data component. */
> ! tmp = build_call_expr (gfor_fndecl_deallocate, 2, var, pstat);
> gfc_add_expr_to_block (&block, tmp);
>
> /* Zero the data pointer. */
> *************** gfc_trans_auto_array_allocation (tree de
> *** 3826,3840 ****
> size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp);
>
> /* Allocate memory to hold the data. */
> - tmp = gfc_chainon_list (NULL_TREE, size);
> -
> if (gfc_index_integer_kind == 4)
> fndecl = gfor_fndecl_internal_malloc;
> else if (gfc_index_integer_kind == 8)
> fndecl = gfor_fndecl_internal_malloc64;
> else
> gcc_unreachable ();
> ! tmp = build_function_call_expr (fndecl, tmp);
> tmp = fold (convert (TREE_TYPE (decl), tmp));
> gfc_add_modify_expr (&block, decl, tmp);
>
> --- 3809,3821 ----
> size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp);
>
> /* Allocate memory to hold the data. */
> if (gfc_index_integer_kind == 4)
> fndecl = gfor_fndecl_internal_malloc;
> else if (gfc_index_integer_kind == 8)
> fndecl = gfor_fndecl_internal_malloc64;
> else
> gcc_unreachable ();
> ! tmp = build_call_expr (fndecl, 1, size);
> tmp = fold (convert (TREE_TYPE (decl), tmp));
> gfc_add_modify_expr (&block, decl, tmp);
>
> *************** gfc_trans_auto_array_allocation (tree de
> *** 3850,3857 ****
>
> /* Free the temporary. */
> tmp = convert (pvoid_type_node, decl);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> return gfc_finish_block (&block);
> --- 3831,3837 ----
>
> /* Free the temporary. */
> tmp = convert (pvoid_type_node, decl);
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> return gfc_finish_block (&block);
> *************** gfc_trans_dummy_array_bias (gfc_symbol *
> *** 4020,4027 ****
> gcc_assert (integer_onep (GFC_TYPE_ARRAY_STRIDE (type, 0)));
> /* A library call to repack the array if necessary. */
> tmp = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! stmt_unpacked = build_function_call_expr (gfor_fndecl_in_pack, tmp);
>
> stride = gfc_index_one_node;
> }
> --- 4000,4006 ----
> gcc_assert (integer_onep (GFC_TYPE_ARRAY_STRIDE (type, 0)));
> /* A library call to repack the array if necessary. */
> tmp = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
> ! stmt_unpacked = build_call_expr (gfor_fndecl_in_pack, 1, tmp);
>
> stride = gfc_index_one_node;
> }
> *************** gfc_trans_dummy_array_bias (gfc_symbol *
> *** 4203,4217 ****
> if (sym->attr.intent != INTENT_IN)
> {
> /* Copy the data back. */
> ! tmp = gfc_chainon_list (NULL_TREE, dumdesc);
> ! tmp = gfc_chainon_list (tmp, tmpdesc);
> ! tmp = build_function_call_expr (gfor_fndecl_in_unpack, tmp);
> gfc_add_expr_to_block (&cleanup, tmp);
> }
>
> /* Free the temporary. */
> ! tmp = gfc_chainon_list (NULL_TREE, tmpdesc);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
> gfc_add_expr_to_block (&cleanup, tmp);
>
> stmt = gfc_finish_block (&cleanup);
> --- 4182,4193 ----
> if (sym->attr.intent != INTENT_IN)
> {
> /* Copy the data back. */
> ! tmp = build_call_expr (gfor_fndecl_in_unpack, 2, dumdesc, tmpdesc);
> gfc_add_expr_to_block (&cleanup, tmp);
> }
>
> /* Free the temporary. */
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmpdesc);
> gfc_add_expr_to_block (&cleanup, tmp);
>
> stmt = gfc_finish_block (&cleanup);
> *************** gfc_conv_array_parameter (gfc_se * se, g
> *** 4778,4800 ****
> {
> desc = se->expr;
> /* Repack the array. */
> ! tmp = gfc_chainon_list (NULL_TREE, desc);
> ! ptr = build_function_call_expr (gfor_fndecl_in_pack, tmp);
> ptr = gfc_evaluate_now (ptr, &se->pre);
> se->expr = ptr;
>
> gfc_start_block (&block);
>
> /* Copy the data back. */
> ! tmp = gfc_chainon_list (NULL_TREE, desc);
> ! tmp = gfc_chainon_list (tmp, ptr);
> ! tmp = build_function_call_expr (gfor_fndecl_in_unpack, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> /* Free the temporary. */
> tmp = convert (pvoid_type_node, ptr);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> stmt = gfc_finish_block (&block);
> --- 4754,4772 ----
> {
> desc = se->expr;
> /* Repack the array. */
> ! ptr = build_call_expr (gfor_fndecl_in_pack, 1, desc);
> ptr = gfc_evaluate_now (ptr, &se->pre);
> se->expr = ptr;
>
> gfc_start_block (&block);
>
> /* Copy the data back. */
> ! tmp = build_call_expr (gfor_fndecl_in_unpack, 2, desc, ptr);
> gfc_add_expr_to_block (&block, tmp);
>
> /* Free the temporary. */
> tmp = convert (pvoid_type_node, ptr);
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> stmt = gfc_finish_block (&block);
> *************** gfc_trans_dealloc_allocated (tree descri
> *** 4836,4844 ****
> /* Call array_deallocate with an int* present in the second argument.
> Although it is ignored here, it's presence ensures that arrays that
> are already deallocated are ignored. */
> ! tmp = gfc_chainon_list (NULL_TREE, var);
> ! tmp = gfc_chainon_list (tmp, ptr);
> ! tmp = build_function_call_expr (gfor_fndecl_deallocate, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> /* Zero the data pointer. */
> --- 4808,4814 ----
> /* Call array_deallocate with an int* present in the second argument.
> Although it is ignored here, it's presence ensures that arrays that
> are already deallocated are ignored. */
> ! tmp = build_call_expr (gfor_fndecl_deallocate, 2, var, ptr);
> gfc_add_expr_to_block (&block, tmp);
>
> /* Zero the data pointer. */
> *************** gfc_duplicate_allocatable(tree dest, tre
> *** 4880,4886 ****
> tree tmp;
> tree size;
> tree nelems;
> - tree args;
> tree null_cond;
> tree null_data;
> stmtblock_t block;
> --- 4850,4855 ----
> *************** gfc_duplicate_allocatable(tree dest, tre
> *** 4897,4907 ****
> TYPE_SIZE_UNIT (gfc_get_element_type (type)));
>
> /* Allocate memory to the destination. */
> - tmp = gfc_chainon_list (NULL_TREE, size);
> if (gfc_index_integer_kind == 4)
> ! tmp = build_function_call_expr (gfor_fndecl_internal_malloc, tmp);
> else if (gfc_index_integer_kind == 8)
> ! tmp = build_function_call_expr (gfor_fndecl_internal_malloc64, tmp);
> else
> gcc_unreachable ();
> tmp = fold (convert (TREE_TYPE (gfc_conv_descriptor_data_get (src)),
> --- 4866,4875 ----
> TYPE_SIZE_UNIT (gfc_get_element_type (type)));
>
> /* Allocate memory to the destination. */
> if (gfc_index_integer_kind == 4)
> ! tmp = build_call_expr (gfor_fndecl_internal_malloc, 1, size);
> else if (gfc_index_integer_kind == 8)
> ! tmp = build_call_expr (gfor_fndecl_internal_malloc64, 1, size);
> else
> gcc_unreachable ();
> tmp = fold (convert (TREE_TYPE (gfc_conv_descriptor_data_get (src)),
> *************** gfc_duplicate_allocatable(tree dest, tre
> *** 4910,4922 ****
>
> /* We know the temporary and the value will be the same length,
> so can use memcpy. */
> - tmp = gfc_conv_descriptor_data_get (dest);
> - args = gfc_chainon_list (NULL_TREE, tmp);
> - tmp = gfc_conv_descriptor_data_get (src);
> - args = gfc_chainon_list (args, tmp);
> - args = gfc_chainon_list (args, size);
> tmp = built_in_decls[BUILT_IN_MEMCPY];
> ! tmp = build_function_call_expr (tmp, args);
> gfc_add_expr_to_block (&block, tmp);
> tmp = gfc_finish_block (&block);
>
> --- 4878,4886 ----
>
> /* We know the temporary and the value will be the same length,
> so can use memcpy. */
> tmp = built_in_decls[BUILT_IN_MEMCPY];
> ! tmp = build_call_expr (tmp, 3, gfc_conv_descriptor_data_get (dest),
> ! gfc_conv_descriptor_data_get (src), size);
> gfc_add_expr_to_block (&block, tmp);
> tmp = gfc_finish_block (&block);
>
> Index: gcc/fortran/trans-openmp.c
> ===================================================================
> *** gcc/fortran/trans-openmp.c (revision 121818)
> --- gcc/fortran/trans-openmp.c (working copy)
> *************** static tree
> *** 875,881 ****
> gfc_trans_omp_barrier (void)
> {
> tree decl = built_in_decls [BUILT_IN_GOMP_BARRIER];
> ! return build_function_call_expr (decl, NULL);
> }
>
> static tree
> --- 875,881 ----
> gfc_trans_omp_barrier (void)
> {
> tree decl = built_in_decls [BUILT_IN_GOMP_BARRIER];
> ! return build_call_expr (decl, 0);
> }
>
> static tree
> *************** static tree
> *** 1054,1060 ****
> gfc_trans_omp_flush (void)
> {
> tree decl = built_in_decls [BUILT_IN_SYNCHRONIZE];
> ! return build_function_call_expr (decl, NULL);
> }
>
> static tree
> --- 1054,1060 ----
> gfc_trans_omp_flush (void)
> {
> tree decl = built_in_decls [BUILT_IN_SYNCHRONIZE];
> ! return build_call_expr (decl, 0);
> }
>
> static tree
> Index: gcc/fortran/trans-stmt.c
> ===================================================================
> *** gcc/fortran/trans-stmt.c (revision 121818)
> --- gcc/fortran/trans-stmt.c (working copy)
> *************** gfc_conv_elemental_dependencies (gfc_se
> *** 295,303 ****
> gfc_add_modify_expr (&se->pre, info->offset, offset);
>
> /* Copy the result back using unpack. */
> ! tmp = gfc_chainon_list (NULL_TREE, parmse.expr);
> ! tmp = gfc_chainon_list (tmp, data);
> ! tmp = build_function_call_expr (gfor_fndecl_in_unpack, tmp);
> gfc_add_expr_to_block (&se->post, tmp);
>
> gfc_add_block_to_block (&se->post, &parmse.post);
> --- 295,301 ----
> gfc_add_modify_expr (&se->pre, info->offset, offset);
>
> /* Copy the result back using unpack. */
> ! tmp = build_call_expr (gfor_fndecl_in_unpack, 2, parmse.expr, data);
> gfc_add_expr_to_block (&se->post, tmp);
>
> gfc_add_block_to_block (&se->post, &parmse.post);
> *************** gfc_trans_pause (gfc_code * code)
> *** 470,478 ****
> {
> tree gfc_int4_type_node = gfc_get_int_type (4);
> gfc_se se;
> - tree args;
> tree tmp;
> - tree fndecl;
>
> /* Start a new block for this statement. */
> gfc_init_se (&se, NULL);
> --- 468,474 ----
> *************** gfc_trans_pause (gfc_code * code)
> *** 482,499 ****
> if (code->expr == NULL)
> {
> tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
> ! args = gfc_chainon_list (NULL_TREE, tmp);
> ! fndecl = gfor_fndecl_pause_numeric;
> }
> else
> {
> gfc_conv_expr_reference (&se, code->expr);
> ! args = gfc_chainon_list (NULL_TREE, se.expr);
> ! args = gfc_chainon_list (args, se.string_length);
> ! fndecl = gfor_fndecl_pause_string;
> }
>
> - tmp = build_function_call_expr (fndecl, args);
> gfc_add_expr_to_block (&se.pre, tmp);
>
> gfc_add_block_to_block (&se.pre, &se.post);
> --- 478,492 ----
> if (code->expr == NULL)
> {
> tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
> ! tmp = build_call_expr (gfor_fndecl_pause_numeric, 1, tmp);
> }
> else
> {
> gfc_conv_expr_reference (&se, code->expr);
> ! tmp = build_call_expr (gfor_fndecl_pause_string, 2,
> ! se.expr, se.string_length);
> }
>
> gfc_add_expr_to_block (&se.pre, tmp);
>
> gfc_add_block_to_block (&se.pre, &se.post);
> *************** gfc_trans_stop (gfc_code * code)
> *** 510,518 ****
> {
> tree gfc_int4_type_node = gfc_get_int_type (4);
> gfc_se se;
> - tree args;
> tree tmp;
> - tree fndecl;
>
> /* Start a new block for this statement. */
> gfc_init_se (&se, NULL);
> --- 503,509 ----
> *************** gfc_trans_stop (gfc_code * code)
> *** 522,539 ****
> if (code->expr == NULL)
> {
> tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
> ! args = gfc_chainon_list (NULL_TREE, tmp);
> ! fndecl = gfor_fndecl_stop_numeric;
> }
> else
> {
> gfc_conv_expr_reference (&se, code->expr);
> ! args = gfc_chainon_list (NULL_TREE, se.expr);
> ! args = gfc_chainon_list (args, se.string_length);
> ! fndecl = gfor_fndecl_stop_string;
> }
>
> - tmp = build_function_call_expr (fndecl, args);
> gfc_add_expr_to_block (&se.pre, tmp);
>
> gfc_add_block_to_block (&se.pre, &se.post);
> --- 513,527 ----
> if (code->expr == NULL)
> {
> tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
> ! tmp = build_call_expr (gfor_fndecl_stop_numeric, 1, tmp);
> }
> else
> {
> gfc_conv_expr_reference (&se, code->expr);
> ! tmp = build_call_expr (gfor_fndecl_stop_string, 2,
> ! se.expr, se.string_length);
> }
>
> gfc_add_expr_to_block (&se.pre, tmp);
>
> gfc_add_block_to_block (&se.pre, &se.post);
> *************** gfc_trans_logical_select (gfc_code * cod
> *** 1308,1314 ****
> static tree
> gfc_trans_character_select (gfc_code *code)
> {
> ! tree init, node, end_label, tmp, type, args, *labels;
> tree case_label;
> stmtblock_t block, body;
> gfc_case *cp, *d;
> --- 1296,1302 ----
> static tree
> gfc_trans_character_select (gfc_code *code)
> {
> ! tree init, node, end_label, tmp, type, *labels;
> tree case_label;
> stmtblock_t block, body;
> gfc_case *cp, *d;
> *************** gfc_trans_character_select (gfc_code *co
> *** 1449,1473 ****
> DECL_INITIAL (tmp) = init;
> init = tmp;
>
> ! /* Build an argument list for the library call */
> init = gfc_build_addr_expr (pvoid_type_node, init);
> - args = gfc_chainon_list (NULL_TREE, init);
> -
> - tmp = build_int_cst (NULL_TREE, n);
> - args = gfc_chainon_list (args, tmp);
> -
> tmp = gfc_build_addr_expr (pvoid_type_node, end_label);
> - args = gfc_chainon_list (args, tmp);
>
> gfc_init_se (&se, NULL);
> gfc_conv_expr_reference (&se, code->expr);
>
> - args = gfc_chainon_list (args, se.expr);
> - args = gfc_chainon_list (args, se.string_length);
> -
> gfc_add_block_to_block (&block, &se.pre);
>
> ! tmp = build_function_call_expr (gfor_fndecl_select_string, args);
> case_label = gfc_create_var (TREE_TYPE (tmp), "case_label");
> gfc_add_modify_expr (&block, case_label, tmp);
>
> --- 1437,1455 ----
> DECL_INITIAL (tmp) = init;
> init = tmp;
>
> ! /* Build the library call */
> init = gfc_build_addr_expr (pvoid_type_node, init);
> tmp = gfc_build_addr_expr (pvoid_type_node, end_label);
>
> gfc_init_se (&se, NULL);
> gfc_conv_expr_reference (&se, code->expr);
>
> gfc_add_block_to_block (&block, &se.pre);
>
> ! tmp = build_call_expr (gfor_fndecl_select_string, 5,
> ! init, build_int_cst (NULL_TREE, n),
> ! tmp, se.expr, se.string_length);
> !
> case_label = gfc_create_var (TREE_TYPE (tmp), "case_label");
> gfc_add_modify_expr (&block, case_label, tmp);
>
> *************** gfc_do_allocate (tree bytesize, tree siz
> *** 1687,1693 ****
> tree tmpvar;
> tree type;
> tree tmp;
> - tree args;
>
> if (INTEGER_CST_P (size))
> {
> --- 1669,1674 ----
> *************** gfc_do_allocate (tree bytesize, tree siz
> *** 1710,1723 ****
> tmpvar = gfc_create_var (build_pointer_type (type), "temp");
> *pdata = convert (pvoid_type_node, tmpvar);
>
> - args = gfc_chainon_list (NULL_TREE, bytesize);
> if (gfc_index_integer_kind == 4)
> tmp = gfor_fndecl_internal_malloc;
> else if (gfc_index_integer_kind == 8)
> tmp = gfor_fndecl_internal_malloc64;
> else
> gcc_unreachable ();
> ! tmp = build_function_call_expr (tmp, args);
> tmp = convert (TREE_TYPE (tmpvar), tmp);
> gfc_add_modify_expr (pblock, tmpvar, tmp);
> }
> --- 1691,1703 ----
> tmpvar = gfc_create_var (build_pointer_type (type), "temp");
> *pdata = convert (pvoid_type_node, tmpvar);
>
> if (gfc_index_integer_kind == 4)
> tmp = gfor_fndecl_internal_malloc;
> else if (gfc_index_integer_kind == 8)
> tmp = gfor_fndecl_internal_malloc64;
> else
> gcc_unreachable ();
> ! tmp = build_call_expr (tmp, 1, bytesize);
> tmp = convert (TREE_TYPE (tmpvar), tmp);
> gfc_add_modify_expr (pblock, tmpvar, tmp);
> }
> *************** gfc_trans_assign_need_temp (gfc_expr * e
> *** 2229,2236 ****
> if (ptemp1)
> {
> /* Free the temporary. */
> ! tmp = gfc_chainon_list (NULL_TREE, ptemp1);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
> gfc_add_expr_to_block (block, tmp);
> }
> }
> --- 2209,2215 ----
> if (ptemp1)
> {
> /* Free the temporary. */
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, ptemp1);
> gfc_add_expr_to_block (block, tmp);
> }
> }
> *************** gfc_trans_pointer_assign_need_temp (gfc_
> *** 2388,2395 ****
> /* Free the temporary. */
> if (ptemp1)
> {
> ! tmp = gfc_chainon_list (NULL_TREE, ptemp1);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
> gfc_add_expr_to_block (block, tmp);
> }
> }
> --- 2367,2373 ----
> /* Free the temporary. */
> if (ptemp1)
> {
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, ptemp1);
> gfc_add_expr_to_block (block, tmp);
> }
> }
> *************** gfc_trans_forall_1 (gfc_code * code, for
> *** 2724,2731 ****
> if (pmask)
> {
> /* Free the temporary for the mask. */
> ! tmp = gfc_chainon_list (NULL_TREE, pmask);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
> gfc_add_expr_to_block (&block, tmp);
> }
> if (maskindex)
> --- 2702,2708 ----
> if (pmask)
> {
> /* Free the temporary for the mask. */
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, pmask);
> gfc_add_expr_to_block (&block, tmp);
> }
> if (maskindex)
> *************** gfc_trans_where_2 (gfc_code * code, tree
> *** 3322,3337 ****
> /* If we allocated a pending mask array, deallocate it now. */
> if (ppmask)
> {
> ! tree args = gfc_chainon_list (NULL_TREE, ppmask);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, args);
> gfc_add_expr_to_block (block, tmp);
> }
>
> /* If we allocated a current mask array, deallocate it now. */
> if (pcmask)
> {
> ! tree args = gfc_chainon_list (NULL_TREE, pcmask);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, args);
> gfc_add_expr_to_block (block, tmp);
> }
> }
> --- 3299,3312 ----
> /* If we allocated a pending mask array, deallocate it now. */
> if (ppmask)
> {
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, ppmask);
> gfc_add_expr_to_block (block, tmp);
> }
>
> /* If we allocated a current mask array, deallocate it now. */
> if (pcmask)
> {
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, pcmask);
> gfc_add_expr_to_block (block, tmp);
> }
> }
> *************** gfc_trans_allocate (gfc_code * code)
> *** 3617,3625 ****
> if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
> tmp = se.string_length;
>
> ! parm = gfc_chainon_list (NULL_TREE, tmp);
> ! parm = gfc_chainon_list (parm, pstat);
> ! tmp = build_function_call_expr (gfor_fndecl_allocate, parm);
> tmp = build2 (MODIFY_EXPR, void_type_node, se.expr, tmp);
> gfc_add_expr_to_block (&se.pre, tmp);
>
> --- 3592,3598 ----
> if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
> tmp = se.string_length;
>
> ! tmp = build_call_expr (gfor_fndecl_allocate, 2, tmp, pstat);
> tmp = build2 (MODIFY_EXPR, void_type_node, se.expr, tmp);
> gfc_add_expr_to_block (&se.pre, tmp);
>
> *************** gfc_trans_deallocate (gfc_code * code)
> *** 3685,3691 ****
> gfc_se se;
> gfc_alloc *al;
> gfc_expr *expr;
> ! tree apstat, astat, parm, pstat, stat, tmp;
> stmtblock_t block;
>
> gfc_start_block (&block);
> --- 3658,3664 ----
> gfc_se se;
> gfc_alloc *al;
> gfc_expr *expr;
> ! tree apstat, astat, pstat, stat, tmp;
> stmtblock_t block;
>
> gfc_start_block (&block);
> *************** gfc_trans_deallocate (gfc_code * code)
> *** 3748,3756 ****
> tmp = gfc_array_deallocate (se.expr, pstat);
> else
> {
> ! parm = gfc_chainon_list (NULL_TREE, se.expr);
> ! parm = gfc_chainon_list (parm, pstat);
> ! tmp = build_function_call_expr (gfor_fndecl_deallocate, parm);
> gfc_add_expr_to_block (&se.pre, tmp);
>
> tmp = build2 (MODIFY_EXPR, void_type_node,
> --- 3721,3727 ----
> tmp = gfc_array_deallocate (se.expr, pstat);
> else
> {
> ! tmp = build_call_expr (gfor_fndecl_deallocate, 2, se.expr, pstat);
> gfc_add_expr_to_block (&se.pre, tmp);
>
> tmp = build2 (MODIFY_EXPR, void_type_node,
> Index: gcc/fortran/trans.c
> ===================================================================
> *** gcc/fortran/trans.c (revision 121818)
> --- gcc/fortran/trans.c (working copy)
> *************** gfc_trans_runtime_check (tree cond, cons
> *** 318,324 ****
> stmtblock_t block;
> tree body;
> tree tmp;
> ! tree args;
> char * message;
> int line;
>
> --- 318,324 ----
> stmtblock_t block;
> tree body;
> tree tmp;
> ! tree arg;
> char * message;
> int line;
>
> *************** gfc_trans_runtime_check (tree cond, cons
> *** 342,352 ****
> asprintf (&message, "%s (in file '%s', around line %d)", _(msgid),
> gfc_source_file, input_line + 1);
>
> ! tmp = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const(message));
> gfc_free(message);
> - args = gfc_chainon_list (NULL_TREE, tmp);
>
> ! tmp = build_function_call_expr (gfor_fndecl_runtime_error, args);
> gfc_add_expr_to_block (&block, tmp);
>
> body = gfc_finish_block (&block);
> --- 342,351 ----
> asprintf (&message, "%s (in file '%s', around line %d)", _(msgid),
> gfc_source_file, input_line + 1);
>
> ! arg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const(message));
> gfc_free(message);
>
> ! tmp = build_call_expr (gfor_fndecl_runtime_error, 1, arg);
> gfc_add_expr_to_block (&block, tmp);
>
> body = gfc_finish_block (&block);
> *************** gfc_trans_runtime_check (tree cond, cons
> *** 359,367 ****
> {
> /* Tell the compiler that this isn't likely. */
> cond = fold_convert (long_integer_type_node, cond);
> ! tmp = gfc_chainon_list (NULL_TREE, cond);
> ! tmp = gfc_chainon_list (tmp, build_int_cst (long_integer_type_node, 0));
> ! cond = build_function_call_expr (built_in_decls[BUILT_IN_EXPECT], tmp);
> cond = fold_convert (boolean_type_node, cond);
>
> tmp = build3_v (COND_EXPR, cond, body, build_empty_stmt ());
> --- 358,365 ----
> {
> /* Tell the compiler that this isn't likely. */
> cond = fold_convert (long_integer_type_node, cond);
> ! tmp = build_int_cst (long_integer_type_node, 0);
> ! cond = build_call_expr (built_in_decls[BUILT_IN_EXPECT], 2, cond, tmp);
> cond = fold_convert (boolean_type_node, cond);
>
> tmp = build3_v (COND_EXPR, cond, body, build_empty_stmt ());
> Index: gcc/fortran/trans-io.c
> ===================================================================
> *** gcc/fortran/trans-io.c (revision 121818)
> --- gcc/fortran/trans-io.c (working copy)
> *************** gfc_trans_open (gfc_code * code)
> *** 835,842 ****
> set_parameter_const (&block, var, IOPARM_common_flags, mask);
>
> tmp = build_fold_addr_expr (var);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (iocall[IOCALL_OPEN], tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &post_block);
> --- 835,841 ----
> set_parameter_const (&block, var, IOPARM_common_flags, mask);
>
> tmp = build_fold_addr_expr (var);
> ! tmp = build_call_expr (iocall[IOCALL_OPEN], 1, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &post_block);
> *************** gfc_trans_close (gfc_code * code)
> *** 888,895 ****
> set_parameter_const (&block, var, IOPARM_common_flags, mask);
>
> tmp = build_fold_addr_expr (var);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (iocall[IOCALL_CLOSE], tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &post_block);
> --- 887,893 ----
> set_parameter_const (&block, var, IOPARM_common_flags, mask);
>
> tmp = build_fold_addr_expr (var);
> ! tmp = build_call_expr (iocall[IOCALL_CLOSE], 1, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &post_block);
> *************** build_filepos (tree function, gfc_code *
> *** 939,946 ****
> set_parameter_const (&block, var, IOPARM_common_flags, mask);
>
> tmp = build_fold_addr_expr (var);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (function, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &post_block);
> --- 937,943 ----
> set_parameter_const (&block, var, IOPARM_common_flags, mask);
>
> tmp = build_fold_addr_expr (var);
> ! tmp = build_call_expr (function, 1, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &post_block);
> *************** gfc_trans_inquire (gfc_code * code)
> *** 1125,1132 ****
> set_parameter_const (&block, var, IOPARM_common_flags, mask);
>
> tmp = build_fold_addr_expr (var);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (iocall[IOCALL_INQUIRE], tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &post_block);
> --- 1122,1128 ----
> set_parameter_const (&block, var, IOPARM_common_flags, mask);
>
> tmp = build_fold_addr_expr (var);
> ! tmp = build_call_expr (iocall[IOCALL_INQUIRE], 1, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &post_block);
> *************** nml_get_addr_expr (gfc_symbol * sym, gfc
> *** 1248,1255 ****
> call to iocall[IOCALL_SET_NML_VAL]. For derived type variable, recursively
> generate calls to iocall[IOCALL_SET_NML_VAL] for each component. */
>
> - #define NML_FIRST_ARG(a) args = gfc_chainon_list (NULL_TREE, a)
> - #define NML_ADD_ARG(a) args = gfc_chainon_list (args, a)
> #define IARG(i) build_int_cst (gfc_array_index_type, i)
>
> static void
> --- 1244,1249 ----
> *************** transfer_namelist_element (stmtblock_t *
> *** 1263,1269 ****
> tree dt = NULL;
> tree string;
> tree tmp;
> - tree args;
> tree dtype;
> tree dt_parm_addr;
> int n_dim;
> --- 1257,1262 ----
> *************** transfer_namelist_element (stmtblock_t *
> *** 1329,1346 ****
> (address, name, type, kind or string_length, dtype) */
>
> dt_parm_addr = build_fold_addr_expr (dt_parm);
> - NML_FIRST_ARG (dt_parm_addr);
> - NML_ADD_ARG (addr_expr);
> - NML_ADD_ARG (string);
> - NML_ADD_ARG (IARG (ts->kind));
>
> if (ts->type == BT_CHARACTER)
> ! NML_ADD_ARG (ts->cl->backend_decl);
> else
> ! NML_ADD_ARG (build_int_cst (gfc_charlen_type_node, 0));
> !
> ! NML_ADD_ARG (dtype);
> ! tmp = build_function_call_expr (iocall[IOCALL_SET_NML_VAL], args);
> gfc_add_expr_to_block (block, tmp);
>
> /* If the object is an array, transfer rank times:
> --- 1322,1335 ----
> (address, name, type, kind or string_length, dtype) */
>
> dt_parm_addr = build_fold_addr_expr (dt_parm);
>
> if (ts->type == BT_CHARACTER)
> ! tmp = ts->cl->backend_decl;
> else
> ! tmp = build_int_cst (gfc_charlen_type_node, 0);
> ! tmp = build_call_expr (iocall[IOCALL_SET_NML_VAL], 6,
> ! dt_parm_addr, addr_expr, string,
> ! IARG (ts->kind), tmp, dtype);
> gfc_add_expr_to_block (block, tmp);
>
> /* If the object is an array, transfer rank times:
> *************** transfer_namelist_element (stmtblock_t *
> *** 1348,1359 ****
>
> for ( n_dim = 0 ; n_dim < rank ; n_dim++ )
> {
> ! NML_FIRST_ARG (dt_parm_addr);
> ! NML_ADD_ARG (IARG (n_dim));
> ! NML_ADD_ARG (GFC_TYPE_ARRAY_STRIDE (dt, n_dim));
> ! NML_ADD_ARG (GFC_TYPE_ARRAY_LBOUND (dt, n_dim));
> ! NML_ADD_ARG (GFC_TYPE_ARRAY_UBOUND (dt, n_dim));
> ! tmp = build_function_call_expr (iocall[IOCALL_SET_NML_VAL_DIM], args);
> gfc_add_expr_to_block (block, tmp);
> }
>
> --- 1337,1348 ----
>
> for ( n_dim = 0 ; n_dim < rank ; n_dim++ )
> {
> ! tmp = build_call_expr (iocall[IOCALL_SET_NML_VAL_DIM], 5,
> ! dt_parm_addr,
> ! IARG (n_dim),
> ! GFC_TYPE_ARRAY_STRIDE (dt, n_dim),
> ! GFC_TYPE_ARRAY_LBOUND (dt, n_dim),
> ! GFC_TYPE_ARRAY_UBOUND (dt, n_dim));
> gfc_add_expr_to_block (block, tmp);
> }
>
> *************** transfer_namelist_element (stmtblock_t *
> *** 1377,1384 ****
> }
>
> #undef IARG
> - #undef NML_ADD_ARG
> - #undef NML_FIRST_ARG
>
> /* Create a data transfer statement. Not all of the fields are valid
> for both reading and writing, but improper use has been filtered
> --- 1366,1371 ----
> *************** build_dt (tree function, gfc_code * code
> *** 1509,1516 ****
> set_parameter_const (&block, var, IOPARM_common_flags, mask);
>
> tmp = build_fold_addr_expr (var);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (function, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &post_block);
> --- 1496,1502 ----
> set_parameter_const (&block, var, IOPARM_common_flags, mask);
>
> tmp = build_fold_addr_expr (var);
> ! tmp = build_call_expr (function, 1, tmp);
> gfc_add_expr_to_block (&block, tmp);
>
> gfc_add_block_to_block (&block, &post_block);
> *************** gfc_trans_dt_end (gfc_code * code)
> *** 1590,1597 ****
> }
>
> tmp = build_fold_addr_expr (dt_parm);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (function, tmp);
> gfc_add_expr_to_block (&block, tmp);
> gfc_add_block_to_block (&block, dt_post_end_block);
> gfc_init_block (dt_post_end_block);
> --- 1576,1582 ----
> }
>
> tmp = build_fold_addr_expr (dt_parm);
> ! tmp = build_call_expr (function, 1, tmp);
> gfc_add_expr_to_block (&block, tmp);
> gfc_add_block_to_block (&block, dt_post_end_block);
> gfc_init_block (dt_post_end_block);
> *************** transfer_array_component (tree expr, gfc
> *** 1702,1708 ****
> static void
> transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr)
> {
> ! tree args, tmp, function, arg2, field, expr;
> gfc_component *c;
> int kind;
>
> --- 1687,1693 ----
> static void
> transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr)
> {
> ! tree tmp, function, arg2, field, expr;
> gfc_component *c;
> int kind;
>
> *************** transfer_expr (gfc_se * se, gfc_typespec
> *** 1777,1787 ****
> }
>
> tmp = build_fold_addr_expr (dt_parm);
> ! args = gfc_chainon_list (NULL_TREE, tmp);
> ! args = gfc_chainon_list (args, addr_expr);
> ! args = gfc_chainon_list (args, arg2);
> !
> ! tmp = build_function_call_expr (function, args);
> gfc_add_expr_to_block (&se->pre, tmp);
> gfc_add_block_to_block (&se->pre, &se->post);
>
> --- 1762,1768 ----
> }
>
> tmp = build_fold_addr_expr (dt_parm);
> ! tmp = build_call_expr (function, 3, tmp, addr_expr, arg2);
> gfc_add_expr_to_block (&se->pre, tmp);
> gfc_add_block_to_block (&se->pre, &se->post);
>
> *************** transfer_expr (gfc_se * se, gfc_typespec
> *** 1794,1800 ****
> static void
> transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr)
> {
> ! tree args, tmp, charlen_arg, kind_arg;
>
> if (ts->type == BT_CHARACTER)
> charlen_arg = se->string_length;
> --- 1775,1781 ----
> static void
> transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr)
> {
> ! tree tmp, charlen_arg, kind_arg;
>
> if (ts->type == BT_CHARACTER)
> charlen_arg = se->string_length;
> *************** transfer_array_desc (gfc_se * se, gfc_ty
> *** 1804,1814 ****
> kind_arg = build_int_cst (NULL_TREE, ts->kind);
>
> tmp = build_fold_addr_expr (dt_parm);
> ! args = gfc_chainon_list (NULL_TREE, tmp);
> ! args = gfc_chainon_list (args, addr_expr);
> ! args = gfc_chainon_list (args, kind_arg);
> ! args = gfc_chainon_list (args, charlen_arg);
> ! tmp = build_function_call_expr (iocall[IOCALL_X_ARRAY], args);
> gfc_add_expr_to_block (&se->pre, tmp);
> gfc_add_block_to_block (&se->pre, &se->post);
> }
> --- 1785,1792 ----
> kind_arg = build_int_cst (NULL_TREE, ts->kind);
>
> tmp = build_fold_addr_expr (dt_parm);
> ! tmp = build_call_expr (iocall[IOCALL_X_ARRAY], 4,
> ! tmp, addr_expr, kind_arg, charlen_arg);
> gfc_add_expr_to_block (&se->pre, tmp);
> gfc_add_block_to_block (&se->pre, &se->post);
> }
> Index: gcc/fortran/trans-decl.c
> ===================================================================
> *** gcc/fortran/trans-decl.c (revision 121818)
> --- gcc/fortran/trans-decl.c (working copy)
> *************** gfc_generate_function_code (gfc_namespac
> *** 3135,3157 ****
>
> if (sym->attr.is_main_program)
> {
> ! tree arglist, gfc_int4_type_node;
> !
> ! gfc_int4_type_node = gfc_get_int_type (4);
> ! arglist = gfc_chainon_list (NULL_TREE,
> ! build_int_cst (gfc_int4_type_node,
> ! gfc_option.warn_std));
> ! arglist = gfc_chainon_list (arglist,
> ! build_int_cst (gfc_int4_type_node,
> ! gfc_option.allow_std));
> ! arglist = gfc_chainon_list (arglist,
> ! build_int_cst (gfc_int4_type_node,
> ! pedantic));
> ! arglist = gfc_chainon_list (arglist,
> ! build_int_cst (gfc_int4_type_node,
> ! gfc_option.flag_dump_core));
> !
> ! tmp = build_function_call_expr (gfor_fndecl_set_std, arglist);
> gfc_add_expr_to_block (&body, tmp);
> }
>
> --- 3135,3150 ----
>
> if (sym->attr.is_main_program)
> {
> ! tree gfc_int4_type_node = gfc_get_int_type (4);
> ! tmp = build_call_expr (gfor_fndecl_set_std, 3,
> ! build_int_cst (gfc_int4_type_node,
> ! gfc_option.warn_std),
> ! build_int_cst (gfc_int4_type_node,
> ! gfc_option.allow_std),
> ! build_int_cst (gfc_int4_type_node,
> ! pedantic),
> ! build_int_cst (gfc_int4_type_node,
> ! gfc_option.flag_dump_core));
> gfc_add_expr_to_block (&body, tmp);
> }
>
> *************** gfc_generate_function_code (gfc_namespac
> *** 3160,3172 ****
> needed. */
> if (sym->attr.is_main_program && gfc_option.fpe != 0)
> {
> ! tree arglist, gfc_c_int_type_node;
> !
> ! gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
> ! arglist = gfc_chainon_list (NULL_TREE,
> ! build_int_cst (gfc_c_int_type_node,
> ! gfc_option.fpe));
> ! tmp = build_function_call_expr (gfor_fndecl_set_fpe, arglist);
> gfc_add_expr_to_block (&body, tmp);
> }
>
> --- 3153,3162 ----
> needed. */
> if (sym->attr.is_main_program && gfc_option.fpe != 0)
> {
> ! tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
> ! tmp = build_call_expr (gfor_fndecl_set_fpe, 1,
> ! build_int_cst (gfc_c_int_type_node,
> ! gfc_option.fpe));
> gfc_add_expr_to_block (&body, tmp);
> }
>
> *************** gfc_generate_function_code (gfc_namespac
> *** 3175,3187 ****
>
> if (sym->attr.is_main_program && gfc_option.convert != CONVERT_NATIVE)
> {
> ! tree arglist, gfc_c_int_type_node;
> !
> ! gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
> ! arglist = gfc_chainon_list (NULL_TREE,
> ! build_int_cst (gfc_c_int_type_node,
> ! gfc_option.convert));
> ! tmp = build_function_call_expr (gfor_fndecl_set_convert, arglist);
> gfc_add_expr_to_block (&body, tmp);
> }
>
> --- 3165,3174 ----
>
> if (sym->attr.is_main_program && gfc_option.convert != CONVERT_NATIVE)
> {
> ! tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
> ! tmp = build_call_expr (gfor_fndecl_set_convert, 1,
> ! build_int_cst (gfc_c_int_type_node,
> ! gfc_option.convert));
> gfc_add_expr_to_block (&body, tmp);
> }
>
> *************** gfc_generate_function_code (gfc_namespac
> *** 3190,3215 ****
>
> if (sym->attr.is_main_program && gfc_option.record_marker != 0)
> {
> ! tree arglist, gfc_c_int_type_node;
> !
> ! gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
> ! arglist = gfc_chainon_list (NULL_TREE,
> ! build_int_cst (gfc_c_int_type_node,
> ! gfc_option.record_marker));
> ! tmp = build_function_call_expr (gfor_fndecl_set_record_marker, arglist);
> gfc_add_expr_to_block (&body, tmp);
> -
> }
>
> if (sym->attr.is_main_program && gfc_option.max_subrecord_length != 0)
> {
> ! tree arglist, gfc_c_int_type_node;
>
> gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
> ! arglist = gfc_chainon_list (NULL_TREE,
> ! build_int_cst (gfc_c_int_type_node,
> ! gfc_option.max_subrecord_length));
> ! tmp = build_function_call_expr (gfor_fndecl_set_max_subrecord_length, arglist);
> gfc_add_expr_to_block (&body, tmp);
> }
>
> --- 3177,3198 ----
>
> if (sym->attr.is_main_program && gfc_option.record_marker != 0)
> {
> ! tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
> ! tmp = build_call_expr (gfor_fndecl_set_record_marker, 1,
> ! build_int_cst (gfc_c_int_type_node,
> ! gfc_option.record_marker));
> gfc_add_expr_to_block (&body, tmp);
> }
>
> if (sym->attr.is_main_program && gfc_option.max_subrecord_length != 0)
> {
> ! tree gfc_c_int_type_node;
>
> gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
> ! tmp = build_call_expr (gfor_fndecl_set_max_subrecord_length,
> ! 1,
> ! build_int_cst (gfc_c_int_type_node,
> ! gfc_option.max_subrecord_length));
> gfc_add_expr_to_block (&body, tmp);
> }
>
> *************** gfc_generate_constructors (void)
> *** 3374,3381 ****
>
> for (; gfc_static_ctors; gfc_static_ctors = TREE_CHAIN (gfc_static_ctors))
> {
> ! tmp =
> ! build_function_call_expr (TREE_VALUE (gfc_static_ctors), NULL_TREE);
> DECL_SAVED_TREE (fndecl) = build_stmt (EXPR_STMT, tmp);
> }
>
> --- 3357,3363 ----
>
> for (; gfc_static_ctors; gfc_static_ctors = TREE_CHAIN (gfc_static_ctors))
> {
> ! tmp = build_call_expr (TREE_VALUE (gfc_static_ctors), 0);
> DECL_SAVED_TREE (fndecl) = build_stmt (EXPR_STMT, tmp);
> }
>
> Index: gcc/fortran/trans-intrinsic.c
> ===================================================================
> *** gcc/fortran/trans-intrinsic.c (revision 121818)
> --- gcc/fortran/trans-intrinsic.c (working copy)
> *************** real_compnt_info;
> *** 164,169 ****
> --- 164,171 ----
> enum rounding_mode { RND_ROUND, RND_TRUNC, RND_CEIL, RND_FLOOR };
>
> /* Evaluate the arguments to an intrinsic function. */
> + /* FIXME: This function and its callers should be rewritten so that it's
> + not necessary to cons up a list to hold the arguments. */
>
> static tree
> gfc_conv_intrinsic_function_args (gfc_se * se, gfc_expr * expr)
> *************** gfc_conv_intrinsic_ctime (gfc_se * se, g
> *** 1273,1280 ****
> /* Free the temporary afterwards, if necessary. */
> cond = build2 (GT_EXPR, boolean_type_node, len,
> build_int_cst (TREE_TYPE (len), 0));
> ! arglist = gfc_chainon_list (NULL_TREE, var);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, arglist);
> tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
> gfc_add_expr_to_block (&se->post, tmp);
>
> --- 1275,1281 ----
> /* Free the temporary afterwards, if necessary. */
> cond = build2 (GT_EXPR, boolean_type_node, len,
> build_int_cst (TREE_TYPE (len), 0));
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
> tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
> gfc_add_expr_to_block (&se->post, tmp);
>
> *************** gfc_conv_intrinsic_fdate (gfc_se * se, g
> *** 1309,1316 ****
> /* Free the temporary afterwards, if necessary. */
> cond = build2 (GT_EXPR, boolean_type_node, len,
> build_int_cst (TREE_TYPE (len), 0));
> ! arglist = gfc_chainon_list (NULL_TREE, var);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, arglist);
> tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
> gfc_add_expr_to_block (&se->post, tmp);
>
> --- 1310,1316 ----
> /* Free the temporary afterwards, if necessary. */
> cond = build2 (GT_EXPR, boolean_type_node, len,
> build_int_cst (TREE_TYPE (len), 0));
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
> tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
> gfc_add_expr_to_block (&se->post, tmp);
>
> *************** gfc_conv_intrinsic_ttynam (gfc_se * se,
> *** 1347,1354 ****
> /* Free the temporary afterwards, if necessary. */
> cond = build2 (GT_EXPR, boolean_type_node, len,
> build_int_cst (TREE_TYPE (len), 0));
> ! arglist = gfc_chainon_list (NULL_TREE, var);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, arglist);
> tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
> gfc_add_expr_to_block (&se->post, tmp);
>
> --- 1347,1353 ----
> /* Free the temporary afterwards, if necessary. */
> cond = build2 (GT_EXPR, boolean_type_node, len,
> build_int_cst (TREE_TYPE (len), 0));
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
> tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
> gfc_add_expr_to_block (&se->post, tmp);
>
> *************** gfc_conv_intrinsic_array_transfer (gfc_s
> *** 2809,2815 ****
> tree lower;
> tree stride;
> tree stmt;
> - tree args;
> gfc_actual_arglist *arg;
> gfc_se argse;
> gfc_ss *ss;
> --- 2808,2813 ----
> *************** gfc_conv_intrinsic_array_transfer (gfc_s
> *** 2850,2864 ****
> && arg->expr->ref->u.ar.type == AR_FULL))
> {
> tmp = build_fold_addr_expr (argse.expr);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! source = build_function_call_expr (gfor_fndecl_in_pack, tmp);
> source = gfc_evaluate_now (source, &argse.pre);
>
> /* Free the temporary. */
> gfc_start_block (&block);
> tmp = convert (pvoid_type_node, source);
> ! tmp = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
> gfc_add_expr_to_block (&block, tmp);
> stmt = gfc_finish_block (&block);
>
> --- 2848,2860 ----
> && arg->expr->ref->u.ar.type == AR_FULL))
> {
> tmp = build_fold_addr_expr (argse.expr);
> ! source = build_call_expr (gfor_fndecl_in_pack, 1, tmp);
> source = gfc_evaluate_now (source, &argse.pre);
>
> /* Free the temporary. */
> gfc_start_block (&block);
> tmp = convert (pvoid_type_node, source);
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
> gfc_add_expr_to_block (&block, tmp);
> stmt = gfc_finish_block (&block);
>
> *************** gfc_conv_intrinsic_array_transfer (gfc_s
> *** 2998,3010 ****
> info, tmp, false, true, false);
>
> /* Use memcpy to do the transfer. */
> ! tmp = gfc_conv_descriptor_data_get (info->descriptor);
> ! args = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = fold_convert (pvoid_type_node, source);
> ! args = gfc_chainon_list (args, source);
> ! args = gfc_chainon_list (args, size_bytes);
> ! tmp = built_in_decls[BUILT_IN_MEMCPY];
> ! tmp = build_function_call_expr (tmp, args);
> gfc_add_expr_to_block (&se->pre, tmp);
>
> se->expr = info->descriptor;
> --- 2994,3004 ----
> info, tmp, false, true, false);
>
> /* Use memcpy to do the transfer. */
> ! tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY],
> ! 3,
> ! gfc_conv_descriptor_data_get (info->descriptor),
> ! fold_convert (pvoid_type_node, source),
> ! size_bytes);
> gfc_add_expr_to_block (&se->pre, tmp);
>
> se->expr = info->descriptor;
> *************** gfc_conv_intrinsic_transfer (gfc_se * se
> *** 3024,3030 ****
> tree type;
> tree ptr;
> gfc_ss *ss;
> ! tree tmpdecl, tmp, args;
>
> /* Get a pointer to the source. */
> arg = expr->value.function.actual;
> --- 3018,3024 ----
> tree type;
> tree ptr;
> gfc_ss *ss;
> ! tree tmpdecl, tmp;
>
> /* Get a pointer to the source. */
> arg = expr->value.function.actual;
> *************** gfc_conv_intrinsic_transfer (gfc_se * se
> *** 3059,3071 ****
>
> /* Use memcpy to do the transfer. */
> tmp = build1 (ADDR_EXPR, build_pointer_type (type), tmpdecl);
> ! tmp = fold_convert (pvoid_type_node, tmp);
> ! args = gfc_chainon_list (NULL_TREE, tmp);
> ! tmp = fold_convert (pvoid_type_node, ptr);
> ! args = gfc_chainon_list (args, tmp);
> ! args = gfc_chainon_list (args, moldsize);
> ! tmp = built_in_decls[BUILT_IN_MEMCPY];
> ! tmp = build_function_call_expr (tmp, args);
> gfc_add_expr_to_block (&se->pre, tmp);
>
> se->expr = tmpdecl;
> --- 3053,3062 ----
>
> /* Use memcpy to do the transfer. */
> tmp = build1 (ADDR_EXPR, build_pointer_type (type), tmpdecl);
> ! tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3,
> ! fold_convert (pvoid_type_node, tmp),
> ! fold_convert (pvoid_type_node, ptr),
> ! moldsize);
> gfc_add_expr_to_block (&se->pre, tmp);
>
> se->expr = tmpdecl;
> *************** gfc_conv_associated (gfc_se *se, gfc_exp
> *** 3112,3118 ****
> gfc_se arg2se;
> tree tmp2;
> tree tmp;
> ! tree args, fndecl;
> tree nonzero_charlen;
> tree nonzero_arraylen;
> gfc_ss *ss1, *ss2;
> --- 3103,3109 ----
> gfc_se arg2se;
> tree tmp2;
> tree tmp;
> ! tree fndecl;
> tree nonzero_charlen;
> tree nonzero_arraylen;
> gfc_ss *ss1, *ss2;
> *************** gfc_conv_associated (gfc_se *se, gfc_exp
> *** 3185,3202 ****
>
> /* A pointer to an array, call library function _gfor_associated. */
> gcc_assert (ss2 != gfc_ss_terminator);
> - args = NULL_TREE;
> arg1se.want_pointer = 1;
> gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
> - args = gfc_chainon_list (args, arg1se.expr);
>
> arg2se.want_pointer = 1;
> gfc_conv_expr_descriptor (&arg2se, arg2->expr, ss2);
> gfc_add_block_to_block (&se->pre, &arg2se.pre);
> gfc_add_block_to_block (&se->post, &arg2se.post);
> - args = gfc_chainon_list (args, arg2se.expr);
> fndecl = gfor_fndecl_associated;
> ! se->expr = build_function_call_expr (fndecl, args);
> se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node,
> se->expr, nonzero_arraylen);
>
> --- 3176,3190 ----
>
> /* A pointer to an array, call library function _gfor_associated. */
> gcc_assert (ss2 != gfc_ss_terminator);
> arg1se.want_pointer = 1;
> gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
>
> arg2se.want_pointer = 1;
> gfc_conv_expr_descriptor (&arg2se, arg2->expr, ss2);
> gfc_add_block_to_block (&se->pre, &arg2se.pre);
> gfc_add_block_to_block (&se->post, &arg2se.post);
> fndecl = gfor_fndecl_associated;
> ! se->expr = build_call_expr (fndecl, 2, arg1se.expr, arg2se.expr);
> se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node,
> se->expr, nonzero_arraylen);
>
> *************** gfc_conv_intrinsic_si_kind (gfc_se * se,
> *** 3287,3294 ****
> args = gfc_conv_intrinsic_function_args (se, expr);
> args = TREE_VALUE (args);
> args = build_fold_addr_expr (args);
> ! args = tree_cons (NULL_TREE, args, NULL_TREE);
> ! se->expr = build_function_call_expr (gfor_fndecl_si_kind, args);
> }
>
> /* Generate code for SELECTED_REAL_KIND (P, R) intrinsic function. */
> --- 3275,3281 ----
> args = gfc_conv_intrinsic_function_args (se, expr);
> args = TREE_VALUE (args);
> args = build_fold_addr_expr (args);
> ! se->expr = build_call_expr (gfor_fndecl_si_kind, 1, args);
> }
>
> /* Generate code for SELECTED_REAL_KIND (P, R) intrinsic function. */
> *************** gfc_conv_intrinsic_trim (gfc_se * se, gf
> *** 3351,3358 ****
> /* Free the temporary afterwards, if necessary. */
> cond = build2 (GT_EXPR, boolean_type_node, len,
> build_int_cst (TREE_TYPE (len), 0));
> ! arglist = gfc_chainon_list (NULL_TREE, var);
> ! tmp = build_function_call_expr (gfor_fndecl_internal_free, arglist);
> tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
> gfc_add_expr_to_block (&se->post, tmp);
>
> --- 3338,3344 ----
> /* Free the temporary afterwards, if necessary. */
> cond = build2 (GT_EXPR, boolean_type_node, len,
> build_int_cst (TREE_TYPE (len), 0));
> ! tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
> tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
> gfc_add_expr_to_block (&se->post, tmp);
>
> *************** gfc_conv_intrinsic_repeat (gfc_se * se,
> *** 3370,3376 ****
> tree tmp;
> tree len;
> tree args;
> - tree arglist;
> tree ncopies;
> tree var;
> tree type;
> --- 3356,3361 ----
> *************** gfc_conv_intrinsic_repeat (gfc_se * se,
> *** 3395,3406 ****
> var = gfc_conv_string_tmp (se, build_pointer_type (type), len);
>
> /* Create the argument list and generate the function call. */
> ! arglist = NULL_TREE;
> ! arglist = gfc_chainon_list (arglist, var);
> ! arglist = gfc_chainon_list (arglist, TREE_VALUE (args));
> ! arglist = gfc_chainon_list (arglist, TREE_VALUE (TREE_CHAIN (args)));
> ! arglist = gfc_chainon_list (arglist, ncopies);
> ! tmp = build_function_call_expr (gfor_fndecl_string_repeat, arglist);
> gfc_add_expr_to_block (&se->pre, tmp);
>
> se->expr = var;
> --- 3380,3388 ----
> var = gfc_conv_string_tmp (se, build_pointer_type (type), len);
>
> /* Create the argument list and generate the function call. */
> ! tmp = build_call_expr (gfor_fndecl_string_repeat, 4, var,
> ! TREE_VALUE (args),
> ! TREE_VALUE (TREE_CHAIN (args)), ncopies);
> gfc_add_expr_to_block (&se->pre, tmp);
>
> se->expr = var;
> *************** gfc_conv_intrinsic_iargc (gfc_se * se, g
> *** 3419,3425 ****
>
> /* Call the library function. This always returns an INTEGER(4). */
> fndecl = gfor_fndecl_iargc;
> ! tmp = build_function_call_expr (fndecl, NULL_TREE);
>
> /* Convert it to the required type. */
> type = gfc_typenode_for_spec (&expr->ts);
> --- 3401,3407 ----
>
> /* Call the library function. This always returns an INTEGER(4). */
> fndecl = gfor_fndecl_iargc;
> ! tmp = build_call_expr (fndecl, 0);
>
> /* Convert it to the required type. */
> type = gfc_typenode_for_spec (&expr->ts);
>
More information about the Fortran
mailing list