Sandra Loosemore - PATCH: CALL_EXPR representation part 9/9 (Fortran front end) (original) (raw)

This is the mail archive of the gcc-patches@gcc.gnu.orgmailing list for the GCC project.

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

This is part 9 of the patch to change the CALL_EXPR representation. This piece includes all the changes to the Fortran front end files in gcc/fortran.-Sandra

2007-02-09 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 121705) --- 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_function_call (gfc_se * se, gfc *** 2408,2415 **** }
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 --- 2389,2396 ---- }
fntype = TREE_TYPE (TREE_TYPE (se->expr)); ! se->expr = build_call_list (CALL_EXPR, TREE_TYPE (fntype), se->expr, ! arglist);
/* If we have a pointer function, but we don't want a pointer, e.g. something like Index: gcc/fortran/trans-array.c

*** gcc/fortran/trans-array.c (revision 121705) --- 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 *** 860,866 **** static void gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra) { ! tree args; tree tmp; tree size; tree ubound; --- 856,862 ---- 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 *** 875,888 **** 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) --- 871,882 ---- 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 *** 893,899 **** gcc_unreachable ();
/ Set the new data pointer. / ! tmp = build_function_call_expr (tmp, args); gfc_conv_descriptor_data_set (pblock, desc, tmp); }
--- 887,893 ---- 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_ *** 1002,1008 **** tree offset, gfc_se * se, gfc_expr * expr) { tree tmp; - tree args;
gfc_conv_expr (se, expr);
--- 996,1001 ---- *************** gfc_trans_array_ctor_element (stmtblock_ *** 1024,1034 **** 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); } } --- 1017,1024 ---- 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 *** 1237,1247 ****
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, --- 1227,1234 ----
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 *** 3522,3534 **** 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);
--- 3509,3519 ---- 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 *** 3564,3572 **** 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. / --- 3549,3555 ---- 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 *** 3857,3871 **** 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);
--- 3840,3852 ---- 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 *** 3881,3888 ****
/ 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); --- 3862,3868 ----
/ 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 * *** 4051,4058 **** 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; } --- 4031,4037 ---- 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 * *** 4234,4248 **** 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); --- 4213,4224 ---- 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 *** 4809,4831 **** { 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); --- 4785,4803 ---- { 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 *** 4867,4875 **** / 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. / --- 4839,4845 ---- / 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 *** 4911,4917 **** tree tmp; tree size; tree nelems; - tree args; tree null_cond; tree null_data; stmtblock_t block; --- 4881,4886 ---- *************** gfc_duplicate_allocatable(tree dest, tre *** 4928,4938 **** 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)), --- 4897,4906 ---- 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 *** 4941,4953 ****
/ 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);
--- 4909,4917 ----
/ 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 121705) --- 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 121705) --- 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_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 *** 2705,2712 **** 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) --- 2683,2689 ---- 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 *** 3303,3318 **** / 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); } } --- 3280,3293 ---- / 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) *** 3598,3606 **** 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);
--- 3573,3579 ---- 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) *** 3666,3672 **** gfc_se se; gfc_alloc *al; gfc_expr *expr; ! tree apstat, astat, parm, pstat, stat, tmp; stmtblock_t block;
gfc_start_block (&block); --- 3639,3645 ---- 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) *** 3729,3737 **** 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, --- 3702,3708 ---- 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 121705) --- 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 121705) --- 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 121705) --- 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,3204 ****
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)

--- 3177,3187 ----
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) *************** 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 121705) --- 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. */

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 *** 2835,2849 **** && 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);

--- 2834,2846 ---- && 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_associated (gfc_se *se, gfc_exp *** 3095,3101 **** gfc_se arg2se; tree tmp2; tree tmp; ! tree args, fndecl; tree nonzero_charlen; tree nonzero_arraylen; gfc_ss *ss1, *ss2; --- 3092,3098 ---- 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 *** 3168,3185 ****

        /* A pointer to an array, call library function _gfor_associated.  */
        gcc_assert (ss2 != gfc_ss_terminator);

! se->expr = build_function_call_expr (fndecl, args); se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node, se->expr, nonzero_arraylen);

--- 3165,3179 ----

        /* 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, *** 3270,3277 **** 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. */ --- 3264,3270 ---- 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 *** 3334,3341 **** / 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);

--- 3327,3333 ---- /* 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, *** 3353,3359 **** tree tmp; tree len; tree args;

! 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;

--- 3369,3377 ---- 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 *** 3402,3408 ****

/* 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);

--- 3390,3396 ----

/* 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);
Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]