Hi all, > I think you should use build_zero_cst(size_type_node) instead of > size_zero_node as size_zero_node is of type sizetype which is not the > same as size_type_node. Otherwise looks good.
In the software design classes I took this was called a design error: Not choosing sufficiently different names for different artifacts. It was considered a beginner's error. So now I have to repeat myself 16 times only to work around this b***. Nothing that will improve gfortran's maintainability. Second version of the changes needed for caf attached. Bootstrapped and regtested fine besides prior known FAIL: gfortran.dg/allocate_deferred_char_scalar_1.f03 -O1 (test for excess errors) on x86_64-linux/f23. - Andre -- Andre Vehreschild * Email: vehre ad gmx dot de
pr78534_caf_v2.clog
Description: Binary data
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 5b05a3d..1604bc8 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -4211,7 +4211,7 @@ size or one for a scalar.
@item @emph{Syntax}:
@code{void caf_register (size_t size, caf_register_t type, caf_token_t *token,
-gfc_descriptor_t *desc, int *stat, char *errmsg, int errmsg_len)}
+gfc_descriptor_t *desc, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4263,7 +4263,7 @@ library is only expected to free memory it allocated itself during a call to
@item @emph{Syntax}:
@code{void caf_deregister (caf_token_t *token, caf_deregister_t type,
-int *stat, char *errmsg, int errmsg_len)}
+int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4322,7 +4322,8 @@ to a remote image identified by the image_index.
@item @emph{Syntax}:
@code{void _gfortran_caf_send (caf_token_t token, size_t offset,
int image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector,
-gfc_descriptor_t *src, int dst_kind, int src_kind, bool may_require_tmp)}
+gfc_descriptor_t *src, int dst_kind, int src_kind, bool may_require_tmp,
+int *stat)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4345,6 +4346,9 @@ time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
or partially) such that walking @var{src} and @var{dest} in element wise
element order (honoring the stride value) will not lead to wrong results.
Otherwise, the value is true.
+@item @var{stat} @tab intent(out) when non-NULL give the result of the
+operation, i.e., zero on success and non-zero on error. When NULL and error
+occurs, then an error message is printed and the program is terminated.
@end multitable
@item @emph{NOTES}
@@ -4375,7 +4379,8 @@ image identified by the image_index.
@item @emph{Syntax}:
@code{void _gfortran_caf_get (caf_token_t token, size_t offset,
int image_index, gfc_descriptor_t *src, caf_vector_t *src_vector,
-gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp)}
+gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp,
+int *stat)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4398,6 +4403,9 @@ time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
or partially) such that walking @var{src} and @var{dest} in element wise
element order (honoring the stride value) will not lead to wrong results.
Otherwise, the value is true.
+@item @var{stat} @tab intent(out) when non-NULL give the result of the
+operation, i.e., zero on success and non-zero on error. When NULL and error
+occurs, then an error message is printed and the program is terminated.
@end multitable
@item @emph{NOTES}
@@ -4430,7 +4438,7 @@ dst_image_index.
int dst_image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector,
caf_token_t src_token, size_t src_offset, int src_image_index,
gfc_descriptor_t *src, caf_vector_t *src_vector, int dst_kind, int src_kind,
-bool may_require_tmp)}
+bool may_require_tmp, int *stat)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4461,6 +4469,9 @@ time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
or partially) such that walking @var{src} and @var{dest} in element wise
element order (honoring the stride value) will not lead to wrong results.
Otherwise, the value is true.
+@item @var{stat} @tab intent(out) when non-NULL give the result of the
+operation, i.e., zero on success and non-zero on error. When NULL and error
+occurs, then an error message is printed and the program is terminated.
@end multitable
@item @emph{NOTES}
@@ -4673,7 +4684,7 @@ been locked by the same image is an error.
@item @emph{Syntax}:
@code{void _gfortran_caf_lock (caf_token_t token, size_t index, int image_index,
-int *aquired_lock, int *stat, char *errmsg, int errmsg_len)}
+int *aquired_lock, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4708,7 +4719,7 @@ which is unlocked or has been locked by a different image is an error.
@item @emph{Syntax}:
@code{void _gfortran_caf_unlock (caf_token_t token, size_t index, int image_index,
-int *stat, char *errmsg, int errmsg_len)}
+int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4740,7 +4751,7 @@ Increment the event count of the specified event variable.
@item @emph{Syntax}:
@code{void _gfortran_caf_event_post (caf_token_t token, size_t index,
-int image_index, int *stat, char *errmsg, int errmsg_len)}
+int image_index, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4777,7 +4788,7 @@ amount and return.
@item @emph{Syntax}:
@code{void _gfortran_caf_event_wait (caf_token_t token, size_t index,
-int until_count, int *stat, char *errmsg, int errmsg_len)}
+int until_count, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4880,7 +4891,7 @@ transfers of previous segment have completed.
@item @emph{Syntax}:
@code{void _gfortran_caf_sync_images (int count, int images[], int *stat,
-char *errmsg, int errmsg_len)}
+char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4908,7 +4919,8 @@ Acts as optimization barrier between different segments. It also ensures that
all pending memory operations of this image have been completed.
@item @emph{Syntax}:
-@code{void _gfortran_caf_sync_memory (int *stat, char *errmsg, int errmsg_len)}
+@code{void _gfortran_caf_sync_memory (int *stat, char *errmsg,
+size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4955,7 +4967,7 @@ Invoked for an @code{ERROR STOP} statement which has a string as argument. The
function should terminate the program with a nonzero-exit code.
@item @emph{Syntax}:
-@code{void _gfortran_caf_error_stop (const char *string, int32_t len)}
+@code{void _gfortran_caf_error_stop (const char *string, size_t len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5116,7 +5128,7 @@ be called collectively.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_broadcast (gfc_descriptor_t *a,
-int source_image, int *stat, char *errmsg, int errmsg_len)}
+int source_image, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5147,7 +5159,7 @@ strings.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_max (gfc_descriptor_t *a, int result_image,
-int *stat, char *errmsg, int a_len, int errmsg_len)}
+int *stat, char *errmsg, int a_len, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5183,7 +5195,7 @@ strings.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_min (gfc_descriptor_t *a, int result_image,
-int *stat, char *errmsg, int a_len, int errmsg_len)}
+int *stat, char *errmsg, int a_len, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5218,7 +5230,7 @@ specified image. This function operates on numeric values.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_sum (gfc_descriptor_t *a, int result_image,
-int *stat, char *errmsg, int errmsg_len)}
+int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5262,7 +5274,7 @@ string lengths shall be specified as hidden argument;
@item @emph{Syntax}:
@code{void _gfortran_caf_co_reduce (gfc_descriptor_t *a,
void * (*opr) (void *, void *), int opr_flags, int result_image,
-int *stat, char *errmsg, int a_len, int errmsg_len)}
+int *stat, char *errmsg, int a_len, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 48d5a79..c559d0e 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -9369,7 +9369,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
build_int_cst (integer_type_node,
GFC_CAF_COARRAY_DEALLOCATE_ONLY),
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&realloc_block, tmp);
tmp = build_call_expr_loc (input_location,
gfor_fndecl_caf_register,
@@ -9378,7 +9378,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY),
token, gfc_build_addr_expr (NULL_TREE, desc),
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&realloc_block, tmp);
}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 504407d..fe07038 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3599,12 +3599,12 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_register")), "RRWWWWR", void_type_node, 7,
size_type_node, integer_type_node, ppvoid_type_node, pvoid_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_deregister = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_deregister")), "WRWWR", void_type_node, 5,
ppvoid_type_node, integer_type_node, pint_type, pchar_type_node,
- integer_type_node);
+ size_type_node);
gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_get")), ".R.RRWRRRW", void_type_node, 10,
@@ -3646,17 +3646,17 @@ gfc_build_builtin_function_decls (void)
boolean_type_node, pint_type, pint_type);
gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
- 3, pint_type, pchar_type_node, integer_type_node);
+ get_identifier (PREFIX("caf_sync_all")), ".WR", void_type_node,
+ 3, pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_sync_memory = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_memory")), ".WW", void_type_node,
- 3, pint_type, pchar_type_node, integer_type_node);
+ get_identifier (PREFIX("caf_sync_memory")), ".WR", void_type_node,
+ 3, pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_images")), ".RRWW", void_type_node,
+ get_identifier (PREFIX("caf_sync_images")), ".RRWR", void_type_node,
5, integer_type_node, pint_type, pint_type,
- pchar_type_node, integer_type_node);
+ pchar_type_node, size_type_node);
gfor_fndecl_caf_error_stop = gfc_build_library_function_decl (
get_identifier (PREFIX("caf_error_stop")),
@@ -3665,97 +3665,99 @@ gfc_build_builtin_function_decls (void)
TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop) = 1;
gfor_fndecl_caf_error_stop_str = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_error_stop_str")), ".R.",
- void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+ get_identifier (PREFIX("caf_error_stop_str")), "RR",
+ void_type_node, 2, pchar_type_node, size_type_node);
/* CAF's ERROR STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str) = 1;
gfor_fndecl_caf_stop_numeric = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_stop_numeric")), ".R.",
+ get_identifier (PREFIX("caf_stop_numeric")), "R",
void_type_node, 1, gfc_int4_type_node);
/* CAF's STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_numeric) = 1;
gfor_fndecl_caf_stop_str = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_stop_str")), ".R.",
- void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+ get_identifier (PREFIX("caf_stop_str")), "RR",
+ void_type_node, 2, pchar_type_node, size_type_node);
/* CAF's STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_str) = 1;
gfor_fndecl_caf_atomic_def = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_define")), "R..RW",
+ get_identifier (PREFIX("caf_atomic_define")), "WRRRWRR",
void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
pvoid_type_node, pint_type, integer_type_node, integer_type_node);
gfor_fndecl_caf_atomic_ref = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_ref")), "R..WW",
+ get_identifier (PREFIX("caf_atomic_ref")), "RRRWWRR",
void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
pvoid_type_node, pint_type, integer_type_node, integer_type_node);
gfor_fndecl_caf_atomic_cas = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_cas")), "R..WRRW",
+ get_identifier (PREFIX("caf_atomic_cas")), "RRRWRRWRR",
void_type_node, 9, pvoid_type_node, size_type_node, integer_type_node,
pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type,
integer_type_node, integer_type_node);
gfor_fndecl_caf_atomic_op = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_op")), ".R..RWW",
+ get_identifier (PREFIX("caf_atomic_op")), "RRRRWRWRR",
void_type_node, 9, integer_type_node, pvoid_type_node, size_type_node,
integer_type_node, pvoid_type_node, pvoid_type_node, pint_type,
integer_type_node, integer_type_node);
gfor_fndecl_caf_lock = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_lock")), "R..WWW",
+ get_identifier (PREFIX("caf_lock")), "RRRWWWR",
void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pint_type, pchar_type_node, integer_type_node);
+ pint_type, pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_unlock = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_unlock")), "R..WW",
+ get_identifier (PREFIX("caf_unlock")), "RRRWWR",
void_type_node, 6, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_event_post = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_event_post")), "R..WW",
+ get_identifier (PREFIX("caf_event_post")), "RRRWWR",
void_type_node, 6, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_event_wait = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_event_wait")), "R..WW",
+ get_identifier (PREFIX("caf_event_wait")), "RRRWWR",
void_type_node, 6, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_event_query = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_event_query")), "R..WW",
+ get_identifier (PREFIX("caf_event_query")), "RRRWW",
void_type_node, 5, pvoid_type_node, size_type_node, integer_type_node,
pint_type, pint_type);
gfor_fndecl_co_broadcast = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_broadcast")), "W.WW",
+ get_identifier (PREFIX("caf_co_broadcast")), "WRWWR",
void_type_node, 5, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_co_max = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_max")), "W.WW",
+ get_identifier (PREFIX("caf_co_max")), "WRWWRR",
void_type_node, 6, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node,
+ size_type_node);
gfor_fndecl_co_min = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_min")), "W.WW",
+ get_identifier (PREFIX("caf_co_min")), "WRWWRR",
void_type_node, 6, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node,
+ size_type_node);
gfor_fndecl_co_reduce = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_reduce")), "W.R.WW",
+ get_identifier (PREFIX("caf_co_reduce")), "WRRRWWRR",
void_type_node, 8, pvoid_type_node,
build_pointer_type (build_varargs_function_type_list (void_type_node,
NULL_TREE)),
integer_type_node, integer_type_node, pint_type, pchar_type_node,
- integer_type_node, integer_type_node);
+ size_type_node, size_type_node);
gfor_fndecl_co_sum = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_sum")), "W.WW",
+ get_identifier (PREFIX("caf_co_sum")), "WRWWR",
void_type_node, 5, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_is_present = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_is_present")), "RRR",
@@ -5134,7 +5136,7 @@ generate_coarray_sym_init (gfc_symbol *sym)
token, gfc_build_addr_expr (pvoid_type_node, desc),
null_pointer_node, /* stat. */
null_pointer_node, /* errgmsg. */
- integer_zero_node); /* errmsg_len. */
+ build_zero_cst (size_type_node));/* errmsg_len. */
gfc_add_expr_to_block (&caf_init_block, tmp);
gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl),
gfc_conv_descriptor_data_get (desc)));
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index fb08ea4..cbff9ae 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7573,7 +7573,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
token),
gfc_build_addr_expr (NULL_TREE, desc),
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&block, tmp);
}
field = cm->backend_decl;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 5461666..bd2b212 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -9605,12 +9605,12 @@ conv_co_collective (gfc_code *code)
gfc_add_block_to_block (&block, &argse.pre);
gfc_add_block_to_block (&post_block, &argse.post);
errmsg = argse.expr;
- errmsg_len = fold_convert (integer_type_node, argse.string_length);
+ errmsg_len = fold_convert (size_type_node, argse.string_length);
}
else
{
errmsg = null_pointer_node;
- errmsg_len = integer_zero_node;
+ errmsg_len = build_zero_cst (size_type_node);
}
/* Generate the function call. */
@@ -10493,7 +10493,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
null_pointer_node));
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
3, null_pointer_node, null_pointer_node,
- build_int_cst (integer_type_node, 0));
+ build_zero_cst (size_type_node));
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, build_empty_stmt (input_location));
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 07b18a6..6741683 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -629,7 +629,6 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
if (code->expr1 == NULL)
{
- tmp = build_int_cst (gfc_int4_type_node, 0);
tmp = build_call_expr_loc (input_location,
error_stop
? (flag_coarray == GFC_FCOARRAY_LIB
@@ -638,7 +637,8 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
: (flag_coarray == GFC_FCOARRAY_LIB
? gfor_fndecl_caf_stop_str
: gfor_fndecl_stop_string),
- 2, build_int_cst (pchar_type_node, 0), tmp);
+ 2, null_pointer_node,
+ build_zero_cst (size_type_node));
}
else if (code->expr1->ts.type == BT_INTEGER)
{
@@ -787,12 +787,12 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
gfc_conv_expr (&argse, code->expr3);
gfc_add_block_to_block (&se.pre, &argse.pre);
errmsg = argse.expr;
- errmsg_len = fold_convert (integer_type_node, argse.string_length);
+ errmsg_len = fold_convert (size_type_node, argse.string_length);
}
else
{
errmsg = null_pointer_node;
- errmsg_len = integer_zero_node;
+ errmsg_len = build_zero_cst (size_type_node);
}
if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
@@ -986,12 +986,12 @@ gfc_trans_event_post_wait (gfc_code *code, gfc_exec_op op)
gfc_conv_expr (&argse, code->expr3);
gfc_add_block_to_block (&se.pre, &argse.pre);
errmsg = argse.expr;
- errmsg_len = fold_convert (integer_type_node, argse.string_length);
+ errmsg_len = fold_convert (size_type_node, argse.string_length);
}
else
{
errmsg = null_pointer_node;
- errmsg_len = integer_zero_node;
+ errmsg_len = build_zero_cst (size_type_node);
}
if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
@@ -1075,7 +1075,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
else if (flag_coarray == GFC_FCOARRAY_LIB)
{
errmsg = null_pointer_node;
- errmsglen = build_int_cst (integer_type_node, 0);
+ errmsglen = build_zero_cst (size_type_node);
}
/* Check SYNC IMAGES(imageset) for valid image index.
@@ -1436,7 +1436,8 @@ gfc_trans_critical (gfc_code *code)
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_lock, 7,
token, integer_zero_node, integer_one_node,
null_pointer_node, null_pointer_node,
- null_pointer_node, integer_zero_node);
+ null_pointer_node,
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&block, tmp);
/* It guarantees memory consistency within the same segment */
@@ -1459,7 +1460,7 @@ gfc_trans_critical (gfc_code *code)
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_unlock, 6,
token, integer_zero_node, integer_one_node,
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&block, tmp);
/* It guarantees memory consistency within the same segment */
@@ -5540,7 +5541,7 @@ gfc_trans_allocate (gfc_code * code)
else
{
errmsg = null_pointer_node;
- errlen = build_int_cst (gfc_charlen_type_node, 0);
+ errlen = build_zero_cst (size_type_node);
}
/* GOTO destinations. */
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index e5dd986..4222d3a 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -728,8 +728,10 @@ gfc_allocate_using_caf_lib (stmtblock_t * block, tree pointer, tree size,
{
gcc_assert(errlen == NULL_TREE);
errmsg = null_pointer_node;
- errlen = build_int_cst (integer_type_node, 0);
+ errlen = build_zero_cst (size_type_node);
}
+ else
+ errlen = fold_convert (size_type_node, errlen);
size = fold_convert (size_type_node, size);
tmp = build_call_expr_loc (input_location,
@@ -1415,7 +1417,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
{
gcc_assert (errlen == NULL_TREE);
errmsg = null_pointer_node;
- errlen = build_zero_cst (integer_type_node);
+ errlen = build_zero_cst (size_type_node);
}
else
{
@@ -1597,7 +1599,8 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
gfor_fndecl_caf_deregister, 5,
token, build_int_cst (integer_type_node,
caf_dereg_type),
- pstat, null_pointer_node, integer_zero_node);
+ pstat, null_pointer_node,
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&non_null, tmp);
/* It guarantees memory consistency within the same segment. */
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 1bb5176..af45356 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -183,28 +183,31 @@ int _gfortran_caf_this_image (int);
int _gfortran_caf_num_images (int, int);
void _gfortran_caf_register (size_t, caf_register_t, caf_token_t *,
- gfc_descriptor_t *, int *, char *, int);
+ gfc_descriptor_t *, int *, char *, size_t);
void _gfortran_caf_deregister (caf_token_t *, caf_deregister_t, int *, char *,
- int);
+ size_t);
-void _gfortran_caf_sync_all (int *, char *, int);
-void _gfortran_caf_sync_memory (int *, char *, int);
-void _gfortran_caf_sync_images (int, int[], int *, char *, int);
+void _gfortran_caf_sync_all (int *, char *, size_t);
+void _gfortran_caf_sync_memory (int *, char *, size_t);
+void _gfortran_caf_sync_images (int, int[], int *, char *, size_t);
void _gfortran_caf_stop_numeric (int32_t)
__attribute__ ((noreturn));
-void _gfortran_caf_stop_str (const char *, int32_t)
+void _gfortran_caf_stop_str (const char *, size_t)
__attribute__ ((noreturn));
-void _gfortran_caf_error_stop_str (const char *, int32_t)
+void _gfortran_caf_error_stop_str (const char *, size_t)
__attribute__ ((noreturn));
void _gfortran_caf_error_stop (int32_t) __attribute__ ((noreturn));
-void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *, int);
-void _gfortran_caf_co_sum (gfc_descriptor_t *, int, int *, char *, int);
-void _gfortran_caf_co_min (gfc_descriptor_t *, int, int *, char *, int, int);
-void _gfortran_caf_co_max (gfc_descriptor_t *, int, int *, char *, int, int);
+void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *,
+ size_t);
+void _gfortran_caf_co_sum (gfc_descriptor_t *, int, int *, char *, size_t);
+void _gfortran_caf_co_min (gfc_descriptor_t *, int, int *, char *, size_t,
+ size_t);
+void _gfortran_caf_co_max (gfc_descriptor_t *, int, int *, char *, size_t,
+ size_t);
void _gfortran_caf_co_reduce (gfc_descriptor_t *, void* (*) (void *, void*),
- int, int, int *, char *, int, int);
+ int, int, int *, char *, size_t, size_t);
void _gfortran_caf_get (caf_token_t, size_t, int, gfc_descriptor_t *,
caf_vector_t *, gfc_descriptor_t *, int, int, bool,
@@ -237,10 +240,11 @@ void _gfortran_caf_atomic_cas (caf_token_t, size_t, int, void *, void *,
void _gfortran_caf_atomic_op (int, caf_token_t, size_t, int, void *, void *,
int *, int, int);
-void _gfortran_caf_lock (caf_token_t, size_t, int, int *, int *, char *, int);
-void _gfortran_caf_unlock (caf_token_t, size_t, int, int *, char *, int);
-void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, int);
-void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, int);
+void _gfortran_caf_lock (caf_token_t, size_t, int, int *, int *, char *,
+ size_t);
+void _gfortran_caf_unlock (caf_token_t, size_t, int, int *, char *, size_t);
+void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, size_t);
+void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, size_t);
void _gfortran_caf_event_query (caf_token_t, size_t, int, int *, int *);
int _gfortran_caf_is_present (caf_token_t, int, caf_reference_t *);
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index d1b3359..6d37965 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -134,7 +134,7 @@ _gfortran_caf_num_images (int distance __attribute__ ((unused)),
void
_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
gfc_descriptor_t *data, int *stat, char *errmsg,
- int errmsg_len)
+ size_t errmsg_len)
{
const char alloc_fail_msg[] = "Failed to allocate coarray";
void *local;
@@ -192,7 +192,7 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
void
_gfortran_caf_deregister (caf_token_t *token, caf_deregister_t type, int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
caf_single_token_t single_token = TOKEN (*token);
@@ -218,7 +218,7 @@ _gfortran_caf_deregister (caf_token_t *token, caf_deregister_t type, int *stat,
void
_gfortran_caf_sync_all (int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
__asm__ __volatile__ ("":::"memory");
if (stat)
@@ -229,7 +229,7 @@ _gfortran_caf_sync_all (int *stat,
void
_gfortran_caf_sync_memory (int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
__asm__ __volatile__ ("":::"memory");
if (stat)
@@ -242,7 +242,7 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)),
int images[] __attribute__ ((unused)),
int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
#ifdef GFC_CAF_CHECK
int i;
@@ -262,14 +262,14 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)),
}
void
-_gfortran_caf_stop_numeric(int32_t stop_code)
+_gfortran_caf_stop_numeric (int32_t stop_code)
{
fprintf (stderr, "STOP %d\n", stop_code);
exit (0);
}
void
-_gfortran_caf_stop_str(const char *string, int32_t len)
+_gfortran_caf_stop_str (const char *string, size_t len)
{
fputs ("STOP ", stderr);
while (len--)
@@ -280,7 +280,7 @@ _gfortran_caf_stop_str(const char *string, int32_t len)
}
void
-_gfortran_caf_error_stop_str (const char *string, int32_t len)
+_gfortran_caf_error_stop_str (const char *string, size_t len)
{
fputs ("ERROR STOP ", stderr);
while (len--)
@@ -303,7 +303,7 @@ void
_gfortran_caf_co_broadcast (gfc_descriptor_t *a __attribute__ ((unused)),
int source_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -313,7 +313,7 @@ void
_gfortran_caf_co_sum (gfc_descriptor_t *a __attribute__ ((unused)),
int result_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -323,8 +323,8 @@ void
_gfortran_caf_co_min (gfc_descriptor_t *a __attribute__ ((unused)),
int result_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int a_len __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t a_len __attribute__ ((unused)),
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -334,8 +334,8 @@ void
_gfortran_caf_co_max (gfc_descriptor_t *a __attribute__ ((unused)),
int result_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int a_len __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t a_len __attribute__ ((unused)),
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -344,13 +344,13 @@ _gfortran_caf_co_max (gfc_descriptor_t *a __attribute__ ((unused)),
void
_gfortran_caf_co_reduce (gfc_descriptor_t *a __attribute__ ((unused)),
- void * (*opr) (void *, void *)
- __attribute__ ((unused)),
- int opr_flags __attribute__ ((unused)),
- int result_image __attribute__ ((unused)),
- int *stat, char *errmsg __attribute__ ((unused)),
- int a_len __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ void * (*opr) (void *, void *)
+ __attribute__ ((unused)),
+ int opr_flags __attribute__ ((unused)),
+ int result_image __attribute__ ((unused)),
+ int *stat, char *errmsg __attribute__ ((unused)),
+ size_t a_len __attribute__ ((unused)),
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -2783,7 +2783,7 @@ void
_gfortran_caf_event_post (caf_token_t token, size_t index,
int image_index __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
uint32_t value = 1;
uint32_t *event = (uint32_t *) ((char *) MEMTOK (token) + index
@@ -2798,7 +2798,7 @@ void
_gfortran_caf_event_wait (caf_token_t token, size_t index,
int until_count, int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
uint32_t *event = (uint32_t *) ((char *) MEMTOK (token) + index
* sizeof (uint32_t));
@@ -2825,7 +2825,8 @@ _gfortran_caf_event_query (caf_token_t token, size_t index,
void
_gfortran_caf_lock (caf_token_t token, size_t index,
int image_index __attribute__ ((unused)),
- int *aquired_lock, int *stat, char *errmsg, int errmsg_len)
+ int *aquired_lock, int *stat, char *errmsg,
+ size_t errmsg_len)
{
const char *msg = "Already locked";
bool *lock = &((bool *) MEMTOK (token))[index];
@@ -2854,22 +2855,21 @@ _gfortran_caf_lock (caf_token_t token, size_t index,
*stat = 1;
if (errmsg_len > 0)
{
- int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
- : (int) sizeof (msg);
+ size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len : sizeof (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
}
return;
}
- _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
+ _gfortran_caf_error_stop_str (msg, strlen (msg));
}
void
_gfortran_caf_unlock (caf_token_t token, size_t index,
int image_index __attribute__ ((unused)),
- int *stat, char *errmsg, int errmsg_len)
+ int *stat, char *errmsg, size_t errmsg_len)
{
const char *msg = "Variable is not locked";
bool *lock = &((bool *) MEMTOK (token))[index];
@@ -2887,15 +2887,14 @@ _gfortran_caf_unlock (caf_token_t token, size_t index,
*stat = 1;
if (errmsg_len > 0)
{
- int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
- : (int) sizeof (msg);
+ size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len : sizeof (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
}
return;
}
- _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
+ _gfortran_caf_error_stop_str (msg, strlen (msg));
}
int
