2014-08-14 Tobias Burnus <burnus@net-b.de>
+ * gfortran.texi (caf_register_t): Add CAF_REGTYPE_CRITICAL.
+ (_gfortran_caf_register): Update for locking/critical.
+ (_gfortran_caf_lock, _gfortran_caf_unlock): Add.
+ * resolve.c (resolve_critical): New.
+ (gfc_resolve_code): Call it.
+ * trans-decl.c (gfor_fndecl_caf_critical,
+ gfor_fndecl_caf_end_critical): Remove.
+ (gfor_fndecl_caf_lock, gfor_fndecl_caf_unlock): Add.
+ (gfc_build_builtin_function_decls): Remove critical,
+ assign locking declarations.
+ (generate_coarray_sym_init): Handle locking and
+ critical variables.
+ * trans-stmt.c (gfc_trans_critical): Add calls to
+ lock/unlock libcaf functions.
+ * trans.h (gfc_coarray_type): Update locking, add
+ critical enum values.
+ (gfor_fndecl_caf_critical, gfor_fndecl_caf_end_critical): Remove.
+ (gfor_fndecl_caf_lock, gfor_fndecl_caf_unlock): Add.
+
+2014-08-14 Tobias Burnus <burnus@net-b.de>
+
* gfortran.texi (Coarray Programming): Add first ABI
documentation.
@top Introduction
@cindex Introduction
-This manual documents the use of @command{gfortran},
+This manual documents the use of @command{gfortran},
the GNU Fortran compiler. You can find in this manual how to invoke
@command{gfortran}, as well as its features and incompatibilities.
@item
Provide information in the generated machine code that can
make it easier to find bugs in the program (using a debugging tool,
-called a @dfn{debugger}, such as the GNU Debugger @command{gdb}).
+called a @dfn{debugger}, such as the GNU Debugger @command{gdb}).
@item
Locate and gather machine code already generated to
perform actions requested by statements in the user's program.
This machine code is organized into @dfn{modules} and is located
-and @dfn{linked} to the user program.
+and @dfn{linked} to the user program.
@end itemize
The GNU Fortran compiler consists of several components:
@itemize
@item @code{DLLEXPORT} -- provide a global pointer to a pointer in the DLL
-@item @code{DLLIMPORT} -- reference the function or variable using a global pointer
+@item @code{DLLIMPORT} -- reference the function or variable using a
+global pointer
@end itemize
For dummy arguments, the @code{NO_ARG_CHECK} attribute can be used; in
Possible values are (bitwise or-ed) @code{GFC_STD_F77} (1),
@code{GFC_STD_F95_OBS} (2), @code{GFC_STD_F95_DEL} (4), @code{GFC_STD_F95}
(8), @code{GFC_STD_F2003} (16), @code{GFC_STD_GNU} (32),
-@code{GFC_STD_LEGACY} (64), @code{GFC_STD_F2008} (128),
+@code{GFC_STD_LEGACY} (64), @code{GFC_STD_F2008} (128),
@code{GFC_STD_F2008_OBS} (256) and GFC_STD_F2008_TS (512). Default:
@code{GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_F95 | GFC_STD_F2003
| GFC_STD_F2008 | GFC_STD_F2008_TS | GFC_STD_F2008_OBS | GFC_STD_F77
the argument passing is modified and no longer completely matches
the platform ABI. Some other Fortran compilers use @code{f2c}
semantic by default; this might cause problems with
-interoperablility.
+interoperablility.
GNU Fortran passes most arguments by reference, i.e. by passing a
pointer to the data. Note that the compiler might use a temporary
CAF_REGTYPE_COARRAY_STATIC,
CAF_REGTYPE_COARRAY_ALLOC,
CAF_REGTYPE_LOCK_STATIC,
- CAF_REGTYPE_LOCK_ALLOC
+ CAF_REGTYPE_LOCK_ALLOC,
+ CAF_REGTYPE_CRITICAL
}
caf_register_t;
@end verbatim
* _gfortran_caf_send:: Sending data from a local image to a remote image
* _gfortran_caf_get:: Getting data from a remote image
* _gfortran_caf_sendget:: Sending data between remote images
+* _gfortran_caf_lock:: Locking a lock variable
+* _gfortran_caf_unlock:: Unlocking a lock variable
@end menu
the failure. The function shall return a pointer to the requested memory
for the local image as a call to @code{malloc} would do.
+For @code{CAF_REGTYPE_COARRAY_STATIC} and @code{CAF_REGTYPE_COARRAY_ALLOC},
+the passed size is the byte size requested. For @code{CAF_REGTYPE_LOCK_STATIC},
+@code{CAF_REGTYPE_LOCK_ALLOC} and @code{CAF_REGTYPE_CRITICAL} it is the array
+size or one for a scalar.
+
+
@item @emph{Syntax}:
@code{void *caf_register (size_t size, caf_register_t type, caf_token_t *token,
int *stat, char *errmsg, int errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{size} @tab byte size of the coarray to be allocated
+@item @var{size} @tab For normal coarrays, the byte size of the coarray to be
+allocated; for lock types, the number of elements.
@item @var{type} @tab one of the caf_register_t types.
@item @var{token} @tab intent(out) An opaque pointer identifying the coarray.
-@item @var{stat} @tab intent(out) For allocatable coarrays, stores the STAT=; may be NULL
-@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to an error message; may be NULL
+@item @var{stat} @tab intent(out) For allocatable coarrays, stores the STAT=;
+may be NULL
+@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to
+an error message; may be NULL
@item @var{errmsg_len} @tab the buffer size of errmsg.
@end multitable
processor, the token is a nonaliasing pointer. The library can, for instance,
store the base address of the coarray in the token, some handle or a more
complicated struct.
+
+For normal coarrays, the returned pointer is used for accesses on the local
+image. For lock types, the value shall only used for checking the allocation
+status. Note that for critical blocks, the locking is only required on one
+image; in the locking statement, the processor shall always pass always an
+image index of one for critical-block lock variables
+(@code{CAF_REGTYPE_CRITICAL}).
@end table
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{stat} @tab intent(out) For allocatable coarrays, stores the STAT=; may be NULL
-@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to an error message; may be NULL
+@item @var{stat} @tab intent(out) For allocatable coarrays, stores the STAT=;
+may be NULL
+@item @var{errmsg} @tab intent(out) When an error occurs, this will be set
+to an error message; may be NULL
@item @var{errmsg_len} @tab the buffer size of errmsg.
@end multitable
@end table
+@node _gfortran_caf_lock
+@subsection @code{_gfortran_caf_lock} --- Locking a lock variable
+@cindex Coarray, _gfortran_caf_lock
+
+@table @asis
+@item @emph{Description}:
+Acquire a lock on the given image on a scalar locking variable or for the
+given array element for an array-valued variable. If the @var{aquired_lock}
+is @code{NULL}, the function return after having obtained the lock. If it is
+nonnull, the result is is assigned the value true (one) when the lock could be
+obtained and false (zero) otherwise. Locking a lock variable which has already
+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)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{token} @tab intent(in) An opaque pointer identifying the coarray.
+@item @var{index} @tab Array index; first array index is 0. For scalars, it is
+always 0.
+@item @var{image_index} @tab The ID of the remote image; must be a positive
+number.
+@item @var{aquired_lock} @tab intent(out) If not NULL, it returns whether lock
+could be obtained
+@item @var{stat} @tab intent(out) For allocatable coarrays, stores the STAT=;
+may be NULL
+@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to
+an error message; may be NULL
+@item @var{errmsg_len} @tab the buffer size of errmsg.
+@end multitable
+
+@item @emph{NOTES}
+This function is also called for critical blocks; for those, the array index
+is always zero and the image index is one. Libraries are permitted to use other
+images for critical-block locking variables.
+@end table
+
+
+@node _gfortran_caf_unlock
+@subsection @code{_gfortran_caf_lock} --- Unlocking a lock variable
+@cindex Coarray, _gfortran_caf_unlock
+
+@table @asis
+@item @emph{Description}:
+Release a lock on the given image on a scalar locking variable or for the
+given array element for an array-valued variable. Unlocking a lock variable
+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)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{token} @tab intent(in) An opaque pointer identifying the coarray.
+@item @var{index} @tab Array index; first array index is 0. For scalars, it is
+always 0.
+@item @var{image_index} @tab The ID of the remote image; must be a positive
+number.
+@item @var{stat} @tab intent(out) For allocatable coarrays, stores the STAT=;
+may be NULL
+@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to
+an error message; may be NULL
+@item @var{errmsg_len} @tab the buffer size of errmsg.
+@end multitable
+
+@item @emph{NOTES}
+This function is also called for critical block; for those, the array index
+is always zero and the image index is one. Libraries are permitted to use other
+images for critical-block locking variables.
+@end table
existing Fortran compilers, but they are not part of the official
J3 Fortran 95 standard.
-@subsection Compiler extensions:
+@subsection Compiler extensions:
@itemize @bullet
@item
User-specified alignment rules for structures.
static void
+resolve_critical (gfc_code *code)
+{
+ gfc_symtree *symtree;
+ gfc_symbol *lock_type;
+ char name[GFC_MAX_SYMBOL_LEN];
+ static int serial = 0;
+
+ if (gfc_option.coarray != GFC_FCOARRAY_LIB)
+ return;
+
+ symtree = gfc_find_symtree (gfc_current_ns->sym_root, "__lock_type@0");
+ if (symtree)
+ lock_type = symtree->n.sym;
+ else
+ {
+ if (gfc_get_sym_tree ("__lock_type@0", gfc_current_ns, &symtree,
+ false) != 0)
+ gcc_unreachable ();
+ lock_type = symtree->n.sym;
+ lock_type->attr.flavor = FL_DERIVED;
+ lock_type->attr.zero_comp = 1;
+ lock_type->from_intmod = INTMOD_ISO_FORTRAN_ENV;
+ lock_type->intmod_sym_id = ISOFORTRAN_LOCK_TYPE;
+ }
+
+ sprintf(name, "__lock_var@%d",serial++);
+ if (gfc_get_sym_tree (name, gfc_current_ns, &symtree, false) != 0)
+ gcc_unreachable ();
+
+ code->resolved_sym = symtree->n.sym;
+ symtree->n.sym->attr.flavor = FL_VARIABLE;
+ symtree->n.sym->attr.referenced = 1;
+ symtree->n.sym->attr.artificial = 1;
+ symtree->n.sym->attr.codimension = 1;
+ symtree->n.sym->ts.type = BT_DERIVED;
+ symtree->n.sym->ts.u.derived = lock_type;
+ symtree->n.sym->as = gfc_get_array_spec ();
+ symtree->n.sym->as->corank = 1;
+ symtree->n.sym->as->type = AS_EXPLICIT;
+ symtree->n.sym->as->cotype = AS_EXPLICIT;
+ symtree->n.sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind,
+ NULL, 1);
+}
+
+
+static void
resolve_sync (gfc_code *code)
{
/* Check imageset. The * case matches expr1 == NULL. */
case EXEC_CONTINUE:
case EXEC_DT_END:
case EXEC_ASSIGN_CALL:
+ break;
+
case EXEC_CRITICAL:
+ resolve_critical (code);
break;
case EXEC_SYNC_ALL:
tree gfor_fndecl_caf_get;
tree gfor_fndecl_caf_send;
tree gfor_fndecl_caf_sendget;
-tree gfor_fndecl_caf_critical;
-tree gfor_fndecl_caf_end_critical;
tree gfor_fndecl_caf_sync_all;
tree gfor_fndecl_caf_sync_images;
tree gfor_fndecl_caf_error_stop;
tree gfor_fndecl_caf_atomic_ref;
tree gfor_fndecl_caf_atomic_cas;
tree gfor_fndecl_caf_atomic_op;
+tree gfor_fndecl_caf_lock;
+tree gfor_fndecl_caf_unlock;
tree gfor_fndecl_co_max;
tree gfor_fndecl_co_min;
tree gfor_fndecl_co_sum;
pvoid_type_node, pvoid_type_node, size_type_node, integer_type_node,
pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node);
- gfor_fndecl_caf_critical = gfc_build_library_function_decl (
- get_identifier (PREFIX("caf_critical")), void_type_node, 0);
-
- gfor_fndecl_caf_end_critical = gfc_build_library_function_decl (
- 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")), ".WW", void_type_node,
3, pint_type, pchar_type_node, integer_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",
+ void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
+ pint_type, pint_type, pchar_type_node, integer_type_node);
+
+ gfor_fndecl_caf_unlock = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_unlock")), "R..WW",
+ void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
+ pint_type, pchar_type_node, integer_type_node);
+
gfor_fndecl_co_max = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_co_max")), "W.WW",
void_type_node, 6, pvoid_type_node, integer_type_node,
generate_coarray_sym_init (gfc_symbol *sym)
{
tree tmp, size, decl, token;
+ bool is_lock_type;
+ int reg_type;
if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension
|| sym->attr.use_assoc || !sym->attr.referenced
TREE_USED(decl) = 1;
gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
+ is_lock_type = sym->ts.type == BT_DERIVED
+ && sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+ && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE;
+
/* FIXME: Workaround for PR middle-end/49106, cf. also PR middle-end/49108
to make sure the variable is not optimized away. */
DECL_PRESERVE_P (DECL_CONTEXT (decl)) = 1;
- size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (decl)));
+ /* For lock types, we pass the array size as only the library knows the
+ size of the variable. */
+ if (is_lock_type)
+ size = gfc_index_one_node;
+ else
+ size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (decl)));
/* Ensure that we do not have size=0 for zero-sized arrays. */
size = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (decl)) != NULL_TREE);
token = gfc_build_addr_expr (ppvoid_type_node,
GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE(decl)));
-
+ if (is_lock_type)
+ reg_type = sym->attr.artificial ? GFC_CAF_CRITICAL : GFC_CAF_LOCK_STATIC;
+ else
+ reg_type = GFC_CAF_COARRAY_STATIC;
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 6, size,
- build_int_cst (integer_type_node,
- GFC_CAF_COARRAY_STATIC), /* type. */
+ build_int_cst (integer_type_node, reg_type),
token, null_pointer_node, /* token, stat. */
null_pointer_node, /* errgmsg, errmsg_len. */
build_int_cst (integer_type_node, 0));
-
gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl), tmp));
-
/* Handle "static" initializer. */
if (sym->value)
{
gfc_trans_critical (gfc_code *code)
{
stmtblock_t block;
- tree tmp;
+ tree tmp, token = NULL_TREE;
gfc_start_block (&block);
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
{
- tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_critical, 0);
+ token = gfc_get_symbol_decl (code->resolved_sym);
+ token = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (token));
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_lock, 7,
+ token, integer_zero_node, integer_one_node,
+ boolean_true_node, null_pointer_node,
+ null_pointer_node, integer_zero_node);
gfc_add_expr_to_block (&block, tmp);
}
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
{
- tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_end_critical,
- 0);
+ 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);
gfc_add_expr_to_block (&block, tmp);
}
{
GFC_CAF_COARRAY_STATIC,
GFC_CAF_COARRAY_ALLOC,
- GFC_CAF_LOCK,
- GFC_CAF_LOCK_COMP
+ GFC_CAF_LOCK_STATIC,
+ GFC_CAF_LOCK_ALLOC,
+ GFC_CAF_CRITICAL
}
gfc_coarray_type;
extern GTY(()) tree gfor_fndecl_caf_get;
extern GTY(()) tree gfor_fndecl_caf_send;
extern GTY(()) tree gfor_fndecl_caf_sendget;
-extern GTY(()) tree gfor_fndecl_caf_critical;
-extern GTY(()) tree gfor_fndecl_caf_end_critical;
extern GTY(()) tree gfor_fndecl_caf_sync_all;
extern GTY(()) tree gfor_fndecl_caf_sync_images;
extern GTY(()) tree gfor_fndecl_caf_error_stop;
extern GTY(()) tree gfor_fndecl_caf_atomic_ref;
extern GTY(()) tree gfor_fndecl_caf_atomic_cas;
extern GTY(()) tree gfor_fndecl_caf_atomic_op;
+extern GTY(()) tree gfor_fndecl_caf_lock;
+extern GTY(()) tree gfor_fndecl_caf_unlock;
extern GTY(()) tree gfor_fndecl_co_max;
extern GTY(()) tree gfor_fndecl_co_min;
extern GTY(()) tree gfor_fndecl_co_sum;
+2014-08-14 Tobias Burnus <burnus@net-b.de>
+
+ * caf/libcaf.h (caf_register_t): Update for critical.
+ (_gfortran_caf_critical, _gfortran_caf_end_critical): Remove.
+ (_gfortran_caf_lock, _gfortran_caf_unlock): Add.
+ * caf/single.c (_gfortran_caf_register): Handle locking
+ variables.
+ (_gfortran_caf_sendget): Re-name args for consistency.
+ (_gfortran_caf_lock, _gfortran_caf_unlock): Add.
+
2014-08-04 Jakub Jelinek <jakub@redhat.com>
* runtime/memory.c (xmallocarray): Avoid division for the common case.
typedef enum caf_register_t {
CAF_REGTYPE_COARRAY_STATIC,
CAF_REGTYPE_COARRAY_ALLOC,
- CAF_REGTYPE_LOCK,
- CAF_REGTYPE_LOCK_COMP
+ CAF_REGTYPE_LOCK_STATIC,
+ CAF_REGTYPE_LOCK_ALLOC,
+ CAF_REGTYPE_CRITICAL
}
caf_register_t;
void _gfortran_caf_sync_all (int *, char *, int);
void _gfortran_caf_sync_images (int, int[], int *, char *, int);
-/* FIXME: The CRITICAL functions should be removed;
- the functionality is better represented using Coarray's lock feature. */
-void _gfortran_caf_critical (void);
-void _gfortran_caf_critical (void) { }
-
-void _gfortran_caf_end_critical (void);
-void _gfortran_caf_end_critical (void) { }
-
-
void _gfortran_caf_error_stop_str (const char *, int32_t)
__attribute__ ((noreturn));
void _gfortran_caf_error_stop (int32_t) __attribute__ ((noreturn));
void *, int *, int, int);
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);
+
#endif /* LIBCAF_H */
{
void *local;
- local = malloc (size);
+ if (type == CAF_REGTYPE_LOCK_STATIC || type == CAF_REGTYPE_LOCK_ALLOC
+ || type == CAF_REGTYPE_CRITICAL)
+ local = calloc (size, sizeof (bool));
+ else
+ local = malloc (size);
*token = malloc (sizeof (single_token_t));
if (unlikely (local == NULL || token == NULL))
if (stat)
*stat = 0;
- if (type == CAF_REGTYPE_COARRAY_STATIC)
+ if (type == CAF_REGTYPE_COARRAY_STATIC || type == CAF_REGTYPE_LOCK_STATIC
+ || type == CAF_REGTYPE_CRITICAL)
{
caf_static_t *tmp = malloc (sizeof (caf_static_t));
tmp->prev = caf_static_list;
void
_gfortran_caf_get (caf_token_t token, size_t offset,
int image_index __attribute__ ((unused)),
- gfc_descriptor_t *src ,
+ gfc_descriptor_t *src,
caf_vector_t *src_vector __attribute__ ((unused)),
gfc_descriptor_t *dest, int src_kind, int dst_kind)
{
int src_image_index __attribute__ ((unused)),
gfc_descriptor_t *src,
caf_vector_t *src_vector __attribute__ ((unused)),
- int dst_len, int src_len)
+ int dst_kind, int src_kind)
{
/* FIXME: Handle vector subscript of 'src_vector'. */
/* For a single image, src->base_addr should be the same as src_token + offset
void *src_base = GFC_DESCRIPTOR_DATA (src);
GFC_DESCRIPTOR_DATA (src) = (void *) ((char *) TOKEN (src_token) + src_offset);
_gfortran_caf_send (dst_token, dst_offset, dst_image_index, dest, dst_vector,
- src, dst_len, src_len);
+ src, dst_kind, src_kind);
GFC_DESCRIPTOR_DATA (src) = src_base;
}
if (stat)
*stat = 0;
}
+
+
+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)
+{
+ const char *msg = "Already locked";
+ bool *lock = &((bool *) TOKEN (token))[index];
+
+ if (!*lock)
+ {
+ *lock = true;
+ if (aquired_lock)
+ *aquired_lock = (int) true;
+ if (stat)
+ *stat = 0;
+ return;
+ }
+
+ if (aquired_lock)
+ {
+ *aquired_lock = (int) false;
+ if (stat)
+ *stat = 0;
+ return;
+ }
+
+
+ if (stat)
+ {
+ *stat = 1;
+ if (errmsg_len > 0)
+ {
+ int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
+ : (int) 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));
+}
+
+
+void
+_gfortran_caf_unlock (caf_token_t token, size_t index,
+ int image_index __attribute__ ((unused)),
+ int *stat, char *errmsg, int errmsg_len)
+{
+ const char *msg = "Variable is not locked";
+ bool *lock = &((bool *) TOKEN (token))[index];
+
+ if (*lock)
+ {
+ *lock = false;
+ if (stat)
+ *stat = 0;
+ return;
+ }
+
+ if (stat)
+ {
+ *stat = 1;
+ if (errmsg_len > 0)
+ {
+ int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
+ : (int) 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));
+}
projects / platform / upstream / linaro-gcc.git / commitdiff