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

gcc/fortran/ChangeLog

@@ -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

gcc/fortran/gfortran.texi

@@ -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
@@ -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{stat} @tab intent(out) For allocatable coarrays, stores the STAT=;
-@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to an error message; may be NULL
+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{stat} @tab intent(out) For allocatable coarrays, stores the STAT=;
-@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to an error message; may be NULL
+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
 
 
 

gcc/fortran/resolve.c

@@ -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:

gcc/fortran/trans-decl.c

@@ -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,10 +4710,19 @@ 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;
 
+  /* 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.  */
@@ -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,
+			     build_int_cst (integer_type_node, reg_type),
-					    GFC_CAF_COARRAY_STATIC), /* 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)
     {

gcc/fortran/trans-stmt.c

@@ -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,
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_unlock, 6,
-				 0);
+				 token, integer_zero_node, integer_one_node,
+				 null_pointer_node, null_pointer_node,
+				 integer_zero_node);
       gfc_add_expr_to_block (&block, tmp);
     }
 

gcc/fortran/trans.h

@@ -107,8 +107,9 @@ typedef enum
 {
   GFC_CAF_COARRAY_STATIC,
   GFC_CAF_COARRAY_ALLOC,
-  GFC_CAF_LOCK,
+  GFC_CAF_LOCK_STATIC,
-  GFC_CAF_LOCK_COMP
+  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;

libgfortran/ChangeLog

@@ -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.

libgfortran/caf/libcaf.h

@@ -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_STATIC,
-  CAF_REGTYPE_LOCK_COMP
+  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  */

libgfortran/caf/single.c

@@ -100,6 +100,10 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
 {
   void *local;
 
+  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));
 
@@ -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;
@@ -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));
+}