gfortran.texi (caf_register_t): Add CAF_REGTYPE_CRITICAL.
gcc/fortran/
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.
libgfortran/
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.
From-SVN: r213979
This commit is contained in:
Tobias Burnus
Tobias Burnus
parent
c194537c63
commit
bc0229f9f6
|
|
@ -1,3 +1,24 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -157,7 +157,7 @@ Boston, MA 02110-1301, USA@*
|
|||
@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.
|
||||
|
||||
|
|
@ -290,13 +290,13 @@ It also helps developers to find bugs in the compiler itself.
|
|||
@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:
|
||||
|
|
@ -2714,7 +2714,8 @@ are in a shared library. The following attributes are available:
|
|||
|
||||
@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
|
||||
|
|
@ -2864,7 +2865,7 @@ if e.g. an input-output edit descriptor is invalid in a given standard.
|
|||
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
|
||||
|
|
@ -3103,7 +3104,7 @@ by-reference argument. Note that with the @option{-ff2c} option,
|
|||
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
|
||||
|
|
@ -3215,7 +3216,8 @@ typedef enum caf_register_t {
|
|||
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
|
||||
|
|
@ -3234,6 +3236,8 @@ caf_register_t;
|
|||
* _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
|
||||
|
||||
|
||||
|
|
@ -3360,17 +3364,26 @@ value and, if not-@code{NULL}, @var{ERRMSG} shall be set to a string describing
|
|||
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
|
||||
|
||||
|
|
@ -3383,6 +3396,13 @@ static memory is used. The token permits to identify the coarray; to the
|
|||
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
|
||||
|
||||
|
||||
|
|
@ -3402,8 +3422,10 @@ int errmsg_len)}
|
|||
|
||||
@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
|
||||
|
||||
|
|
@ -3549,6 +3571,79 @@ character kinds.
|
|||
@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
|
||||
|
||||
|
||||
|
||||
|
|
@ -3693,7 +3788,7 @@ order. Most of these are necessary to be fully compatible with
|
|||
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.
|
||||
|
|
|
|||
|
|
@ -8474,6 +8474,52 @@ resolve_lock_unlock (gfc_code *code)
|
|||
}
|
||||
|
||||
|
||||
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)
|
||||
{
|
||||
|
|
@ -9913,7 +9959,10 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
|
|||
case EXEC_CONTINUE:
|
||||
case EXEC_DT_END:
|
||||
case EXEC_ASSIGN_CALL:
|
||||
break;
|
||||
|
||||
case EXEC_CRITICAL:
|
||||
resolve_critical (code);
|
||||
break;
|
||||
|
||||
case EXEC_SYNC_ALL:
|
||||
|
|
|
|||
|
|
@ -135,8 +135,6 @@ tree gfor_fndecl_caf_deregister;
|
|||
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;
|
||||
|
|
@ -145,6 +143,8 @@ tree gfor_fndecl_caf_atomic_def;
|
|||
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;
|
||||
|
|
@ -3368,12 +3368,6 @@ gfc_build_builtin_function_decls (void)
|
|||
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);
|
||||
|
|
@ -3417,6 +3411,16 @@ gfc_build_builtin_function_decls (void)
|
|||
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,
|
||||
|
|
@ -4694,6 +4698,8 @@ static void
|
|||
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
|
||||
|
|
@ -4704,11 +4710,20 @@ generate_coarray_sym_init (gfc_symbol *sym)
|
|||
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,
|
||||
|
|
@ -4725,17 +4740,17 @@ generate_coarray_sym_init (gfc_symbol *sym)
|
|||
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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1111,13 +1111,18 @@ tree
|
|||
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);
|
||||
}
|
||||
|
||||
|
|
@ -1126,8 +1131,10 @@ gfc_trans_critical (gfc_code *code)
|
|||
|
||||
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);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -107,8 +107,9 @@ typedef enum
|
|||
{
|
||||
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;
|
||||
|
||||
|
|
@ -714,8 +715,6 @@ extern GTY(()) tree gfor_fndecl_caf_deregister;
|
|||
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;
|
||||
|
|
@ -724,6 +723,8 @@ extern GTY(()) tree gfor_fndecl_caf_atomic_def;
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -1,3 +1,13 @@
|
|||
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.
|
||||
|
|
|
|||
|
|
@ -55,8 +55,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|||
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;
|
||||
|
||||
|
|
@ -101,15 +102,6 @@ void _gfortran_caf_deregister (caf_token_t *, int *, char *, int);
|
|||
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));
|
||||
|
|
@ -137,4 +129,8 @@ void _gfortran_caf_atomic_cas (caf_token_t, size_t, int, void *, void *,
|
|||
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 */
|
||||
|
|
|
|||
|
|
@ -100,7 +100,11 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
|
|||
{
|
||||
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))
|
||||
|
|
@ -128,7 +132,8 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
|
|||
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;
|
||||
|
|
@ -526,7 +531,7 @@ error:
|
|||
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)
|
||||
{
|
||||
|
|
@ -764,7 +769,7 @@ _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset,
|
|||
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
|
||||
|
|
@ -772,7 +777,7 @@ _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_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;
|
||||
}
|
||||
|
||||
|
|
@ -864,3 +869,80 @@ _gfortran_caf_atomic_op (int op, caf_token_t token, size_t offset,
|
|||
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));
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue