diff options
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 10 | ||||
-rw-r--r-- | gcc/fortran/trans-stmt.c | 67 |
3 files changed, 68 insertions, 17 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index dad51bf..dbfaa7c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-06-10 Daniel Carrera <dcarrera@gmail.com> + + * trans-decl.c (gfc_build_builtin_function_decls): + Updated declaration of caf_sync_all and caf_sync_images. + * trans-stmt.c (gfc_trans_sync): Function + can now handle a "stat" variable that has an integer type + different from integer_type_node. + 2011-06-09 Richard Guenther <rguenther@suse.de> * trans.c (gfc_allocate_array_with_status): Mark error path diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index a225915..6c6de13 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3059,13 +3059,13 @@ gfc_build_builtin_function_decls (void) get_identifier (PREFIX("caf_end_critical")), void_type_node, 0); gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("caf_sync_all")), ".W", integer_type_node, - 2, build_pointer_type (pchar_type_node), integer_type_node); + get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node, + 3, pint_type, build_pointer_type (pchar_type_node), integer_type_node); gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("caf_sync_images")), ".RRW", integer_type_node, - 4, integer_type_node, pint_type, build_pointer_type (pchar_type_node), - integer_type_node); + get_identifier (PREFIX("caf_sync_images")), ".RRWW", void_type_node, + 5, integer_type_node, pint_type, pint_type, + build_pointer_type (pchar_type_node), integer_type_node); gfor_fndecl_caf_error_stop = gfc_build_library_function_decl ( get_identifier (PREFIX("caf_error_stop")), diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index d2a0a5f..183778f 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -683,6 +683,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) gfc_conv_expr_val (&argse, code->expr2); stat = argse.expr; } + else + stat = null_pointer_node; if (code->expr3 && gfc_option.coarray == GFC_FCOARRAY_LIB && type != EXEC_SYNC_MEMORY) @@ -691,7 +693,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) gfc_init_se (&argse, NULL); gfc_conv_expr (&argse, code->expr3); gfc_conv_string_parameter (&argse); - errmsg = argse.expr; + errmsg = gfc_build_addr_expr (NULL, argse.expr); errmsglen = argse.string_length; } else if (gfc_option.coarray == GFC_FCOARRAY_LIB && type != EXEC_SYNC_MEMORY) @@ -743,12 +745,32 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) } else if (type == EXEC_SYNC_ALL) { - tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all, - 2, errmsg, errmsglen); - if (code->expr2) - gfc_add_modify (&se.pre, stat, fold_convert (TREE_TYPE (stat), tmp)); + /* SYNC ALL => stat == null_pointer_node + SYNC ALL(stat=s) => stat has an integer type + + If "stat" has the wrong integer type, use a temp variable of + the right type and later cast the result back into "stat". */ + if (stat == null_pointer_node || TREE_TYPE (stat) == integer_type_node) + { + if (TREE_TYPE (stat) == integer_type_node) + stat = gfc_build_addr_expr (NULL, stat); + + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all, + 3, stat, errmsg, errmsglen); + gfc_add_expr_to_block (&se.pre, tmp); + } else - gfc_add_expr_to_block (&se.pre, tmp); + { + tree tmp_stat = gfc_create_var (integer_type_node, "stat"); + + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all, + 3, gfc_build_addr_expr (NULL, tmp_stat), + errmsg, errmsglen); + gfc_add_expr_to_block (&se.pre, tmp); + + gfc_add_modify (&se.pre, stat, + fold_convert (TREE_TYPE (stat), tmp_stat)); + } } else { @@ -790,13 +812,34 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) len = fold_convert (integer_type_node, len); } - tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images, 4, - fold_convert (integer_type_node, len), images, - errmsg, errmsglen); - if (code->expr2) - gfc_add_modify (&se.pre, stat, fold_convert (TREE_TYPE (stat), tmp)); + /* SYNC IMAGES(imgs) => stat == null_pointer_node + SYNC IMAGES(imgs,stat=s) => stat has an integer type + + If "stat" has the wrong integer type, use a temp variable of + the right type and later cast the result back into "stat". */ + if (stat == null_pointer_node || TREE_TYPE (stat) == integer_type_node) + { + if (TREE_TYPE (stat) == integer_type_node) + stat = gfc_build_addr_expr (NULL, stat); + + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images, + 5, fold_convert (integer_type_node, len), + images, stat, errmsg, errmsglen); + gfc_add_expr_to_block (&se.pre, tmp); + } else - gfc_add_expr_to_block (&se.pre, tmp); + { + tree tmp_stat = gfc_create_var (integer_type_node, "stat"); + + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images, + 5, fold_convert (integer_type_node, len), + images, gfc_build_addr_expr (NULL, tmp_stat), + errmsg, errmsglen); + gfc_add_expr_to_block (&se.pre, tmp); + + gfc_add_modify (&se.pre, stat, + fold_convert (TREE_TYPE (stat), tmp_stat)); + } } return gfc_finish_block (&se.pre); |