[PATCH 8/13] Coarray shared memory library

commit 290f3b399ec3cb5991e28edf30cc55ba3a39c176
Author: Andre Vehreschild <[email protected]>
Date:   Wed Aug 6 15:36:54 2025 +0200

    Fortran: Fix caf_shmem syncing on Windows.
    
    Cygwin's libc's pthread implementation does not support setting
    pshared on mutexes and condition variables.  Therefore Windows
    synchronisation primitives needed to be used directly.
    On MSYS2/UCRT64 fork and mmap are not available and Windows core
    functionality needs to be used.
    
    libgfortran/ChangeLog:
    
            * caf/shmem.c (_gfortran_caf_init): Cleanup thread helper after
            use.
            (_gfortran_caf_finalize): Same.
            (_gfortran_caf_register): Handle lock_t correctly on Windows.
            (GEN_OP): Prevent warnings on non-initialized.
            (_gfortran_caf_lock): Handle lock_t correctly on Windows.
            (_gfortran_caf_unlock): Same.
            (_gfortran_caf_random_init): Fix formatting.
            (_gfortran_caf_form_team): Add more images to counter_barrier.
            * caf/shmem/alloc.c: Use routines from thread_support.
            * caf/shmem/allocator.c (allocator_lock): Same.
            (allocator_unlock): Same.
            * caf/shmem/allocator.h: Same.
            * caf/shmem/collective_subroutine.c (get_collsub_buf): Same.
            * caf/shmem/collective_subroutine.h: Same.
            * caf/shmem/counter_barrier.c (lock_counter_barrier): Same.
            (unlock_counter_barrier): Same.
            (counter_barrier_init): Same.
            (counter_barrier_wait): Same.
            (change_internal_barrier_count): Same.
            (counter_barrier_add): Same.
            (counter_barrier_init_add): Only increase value w/o signaling.
            (counter_barrier_get_count): Use routines from thread_support.
            * caf/shmem/counter_barrier.h: Same.
            (counter_barrier_init_add): New routine.
            * caf/shmem/shared_memory.c: Use windows routines where
            applicable.
            (shared_memory_set_env): Same.
            (shared_memory_get_master): Same.
            (shared_memory_init): Same.
            (shared_memory_cleanup): Same.
            * caf/shmem/shared_memory.h: Use types from thread_support.
            * caf/shmem/supervisor.c: Use windows routines where applicable.
            (get_memory_size_from_envvar): Same.
            (ensure_shmem_initialization): Same.
            (supervisor_main_loop): Use windows process start on windows
            without fork().
            * caf/shmem/supervisor.h: Use types from thread_support.
            * caf/shmem/sync.c (lock_table): Use routines from thread_support.
            (unlock_table): Same.
            (sync_init): Same.
            (sync_init_supervisor): Same.
            (sync_table): Same.
            (lock_event): Same.
            (unlock_event): Same.
            (event_post): Same.
            (event_wait): Same.
            * caf/shmem/sync.h: Use types from thread_support.
            * caf/shmem/teams_mgmt.c (update_teams_images): Use routines from
            thread_support.
            * caf/shmem/thread_support.c: Add synchronisation primitives for
            windows.
            (smax): Windows only: Max for size_t.
            (get_handle): Windows only: Get the windows handle for a given
            id or create a new one, if it does not exist.
            (get_mutex): Windows only: Shortcut for getting a windows mutex
            handle.
            (get_condvar): Windows only: Same, but for condition variable.
            (thread_support_init_supervisor): Windows only: Clear tracker of
            allocated handle ids.
            (caf_shmem_mutex_lock): Windows only: Implememtation of lock,
            (caf_shmem_mutex_trylock): Windows only: trylock, and
            (caf_shmem_mutex_unlock): Windows only:  unlock for Windows.
            (bm_is_set): Windows only: Check a bit is set in a mask.
            (bm_clear_bit): Windows only: Clear a bit in a mask.
            (bm_set_mask): Windows only: Set all bits in a mask.
            (bm_is_none): Windows only: Check if all bits are cleared.
            (caf_shmem_cond_wait): Windows only: Condition variable
            implemenation fro wait,
            (caf_shmem_cond_broadcast): Windows only: broadcast, and
            (caf_shmem_cond_signal): Windows only: signal on Windows.
            (caf_shmem_cond_update_count): Windows only: Need to know the
            images participating in a condition variable.
            (thread_support_cleanup): Windows only: Clean up the handles on
            exit.
            * caf/shmem/thread_support.h: Conditionally compile the types
            as required for Windows and other OSes.

diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c
index b8d92d657f5..266feab3e45 100644
--- a/libgfortran/caf/shmem.c
+++ b/libgfortran/caf/shmem.c
@@ -94,6 +94,8 @@ _gfortran_caf_init (int *argc, char ***argv)
 
   if (supervisor_main_loop (argc, argv, &exit_code))
     return;
+
+  thread_support_cleanup ();
   shared_memory_cleanup (&local->sm);
 
   /* Free pseudo tokens and memory to allow main process to survive caf_init.
@@ -107,6 +109,7 @@ _gfortran_caf_init (int *argc, char ***argv)
       caf_static_list = tmp;
     }
   free (local);
+
   exit (exit_code);
 }
 
@@ -150,6 +153,8 @@ _gfortran_caf_finalize (void)
   caf_teams_formed = NULL;
 
   free (local);
+
+  thread_support_cleanup ();
 }
 
 int
@@ -267,19 +272,25 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
       {
 	lock_t *addr;
 	bool created;
+	size_t alloc_size;
 
 	allocator_lock (&local->ai.alloc);
-	/* Allocate enough space for the metadata infront of the lock
-	   array.  */
-	addr
-	  = alloc_get_memory_by_id_created (&local->ai, size * sizeof (lock_t),
-					    next_memid, &created);
+#if defined(WIN32) || defined(__CYGWIN__)
+	/* On Windows mutexes are not an object stored in the shmem but
+	   identified by an id.  */
+	alloc_size = size * caf_current_team->u.image_info->image_count.count;
+#else
+	alloc_size = size;
+#endif
+	addr = alloc_get_memory_by_id_created (&local->ai,
+					       alloc_size * sizeof (lock_t),
+					       next_memid, &created);
 
 	if (created)
 	  {
 	    /* Initialize the mutex only, when the memory was allocated for the
 	       first time.  */
-	    for (size_t c = 0; c < size; ++c)
+	    for (size_t c = 0; c < alloc_size; ++c)
 	      initialize_shared_errorcheck_mutex (&addr[c]);
 	  }
 	size *= sizeof (lock_t);
@@ -852,6 +863,7 @@ typedef void *opr_t;
 	default:                                                               \
 	  caf_runtime_error ("" #name                                          \
 			     " not available for type/kind combination");      \
+	  opr = NULL; /* Prevent false warnings.  */                           \
 	}                                                                      \
       break;                                                                   \
     }
@@ -873,10 +885,12 @@ typedef void *opr_t;
 	default:                                                               \
 	  caf_runtime_error ("" #name                                          \
 			     " not available for type/kind combination");      \
+	  opr = NULL; /* Prevent false warning.  */                            \
 	}                                                                      \
       break;                                                                   \
     default:                                                                   \
       caf_runtime_error ("" #name " not available for type/kind combination"); \
+      opr = NULL; /* Prevent false warning.  */                                \
     }
 
 void
@@ -1473,17 +1487,23 @@ _gfortran_caf_event_query (caf_token_t token, size_t index, int image_index,
 }
 
 void
-_gfortran_caf_lock (caf_token_t token, size_t index,
-		    int image_index __attribute__ ((unused)),
+_gfortran_caf_lock (caf_token_t token, size_t index, int image_index,
 		    int *acquired_lock, int *stat, char *errmsg,
 		    size_t errmsg_len)
 {
   const char *msg = "Already locked";
-  lock_t *lock = &((lock_t *) MEMTOK (token))[index];
+#if defined(WIN32) || defined(__CYGWIN__)
+  const size_t lock_index
+    = image_index * caf_current_team->u.image_info->image_count.count + index;
+#else
+  const size_t lock_index = index;
+  (void) image_index; // Prevent unused warnings.
+#endif
+  lock_t *lock = &((lock_t *) MEMTOK (token))[lock_index];
   int res;
 
-  res
-    = acquired_lock ? pthread_mutex_trylock (lock) : pthread_mutex_lock (lock);
+  res = acquired_lock ? caf_shmem_mutex_trylock (lock)
+		      : caf_shmem_mutex_lock (lock);
 
   if (stat)
     *stat = res == EBUSY ? GFC_STAT_LOCKED : 0;
@@ -1501,28 +1521,32 @@ _gfortran_caf_lock (caf_token_t token, size_t index,
     {
       if (errmsg_len > 0)
 	{
-	  size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len
-						      : 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);
+	    memset (&errmsg[len], ' ', errmsg_len - len);
 	}
       return;
     }
   _gfortran_caf_error_stop_str (msg, strlen (msg), false);
 }
 
-
 void
-_gfortran_caf_unlock (caf_token_t token, size_t index,
-		      int image_index __attribute__ ((unused)),
+_gfortran_caf_unlock (caf_token_t token, size_t index, int image_index,
 		      int *stat, char *errmsg, size_t errmsg_len)
 {
   const char *msg = "Variable is not locked";
-  lock_t *lock = &((lock_t *) MEMTOK (token))[index];
+#if defined(WIN32) || defined(__CYGWIN__)
+  const size_t lock_index
+    = image_index * caf_current_team->u.image_info->image_count.count + index;
+#else
+  const size_t lock_index = index;
+  (void) image_index; // Prevent unused warnings.
+#endif
+  lock_t *lock = &((lock_t *) MEMTOK (token))[lock_index];
   int res;
 
-  res = pthread_mutex_unlock (lock);
+  res = caf_shmem_mutex_unlock (lock);
 
   if (res == 0)
     {
@@ -1535,34 +1559,33 @@ _gfortran_caf_unlock (caf_token_t token, size_t index,
     {
       /* res == EPERM means that the lock is locked.  Now figure, if by us by
 	 trying to lock it or by other image, which fails.  */
-      res = pthread_mutex_trylock (lock);
+      res = caf_shmem_mutex_trylock (lock);
       if (res == EBUSY)
 	*stat = GFC_STAT_LOCKED_OTHER_IMAGE;
       else
 	{
 	  *stat = GFC_STAT_UNLOCKED;
-	  pthread_mutex_unlock (lock);
+	  caf_shmem_mutex_unlock (lock);
 	}
 
       if (errmsg_len > 0)
 	{
-	  size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len
-	    : 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);
+	    memset (&errmsg[len], ' ', errmsg_len - len);
 	}
       return;
     }
   _gfortran_caf_error_stop_str (msg, strlen (msg), false);
 }
 
-
 /* Reference the libraries implementation.  */
 extern void _gfortran_random_seed_i4 (int32_t *size, gfc_array_i4 *put,
 				      gfc_array_i4 *get);
 
-void _gfortran_caf_random_init (bool repeatable, bool image_distinct)
+void
+_gfortran_caf_random_init (bool repeatable, bool image_distinct)
 {
   static struct
   {
@@ -1720,8 +1743,8 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
 	   ++i)
 	t->u.image_info->image_map[i] = -1;
     }
-  counter_barrier_add (&t->u.image_info->image_count, 1);
-  counter_barrier_add (&t->u.image_info->collsub.barrier, 1);
+  counter_barrier_init_add (&t->u.image_info->image_count, 1);
+  counter_barrier_init_add (&t->u.image_info->collsub.barrier, 1);
   allocator_unlock (&local->ai.alloc);
 
   if (new_index)
diff --git a/libgfortran/caf/shmem/alloc.c b/libgfortran/caf/shmem/alloc.c
index fecf97c03ff..ea250ac6922 100644
--- a/libgfortran/caf/shmem/alloc.c
+++ b/libgfortran/caf/shmem/alloc.c
@@ -30,9 +30,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "../caf_error.h"
 #include "supervisor.h"
 #include "shared_memory.h"
+#include "thread_support.h"
 
 #include <assert.h>
-#include <pthread.h>
 #include <string.h>
 
 /* Worker's part to initialize the alloc interface.  */
diff --git a/libgfortran/caf/shmem/allocator.c b/libgfortran/caf/shmem/allocator.c
index 3ea4d50e045..2a22abb2a80 100644
--- a/libgfortran/caf/shmem/allocator.c
+++ b/libgfortran/caf/shmem/allocator.c
@@ -133,11 +133,11 @@ allocator_shared_free (allocator *a, shared_mem_ptr p, size_t size)
 void
 allocator_lock (allocator *a)
 {
-  pthread_mutex_lock (&a->s->lock);
+  caf_shmem_mutex_lock (&a->s->lock);
 }
 
 void
 allocator_unlock (allocator *a)
 {
-  pthread_mutex_unlock (&a->s->lock);
+  caf_shmem_mutex_unlock (&a->s->lock);
 }
diff --git a/libgfortran/caf/shmem/allocator.h b/libgfortran/caf/shmem/allocator.h
index 53b6abeeba1..0cf31ea837a 100644
--- a/libgfortran/caf/shmem/allocator.h
+++ b/libgfortran/caf/shmem/allocator.h
@@ -29,16 +29,16 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #define ALLOCATOR_HDR
 
 #include "shared_memory.h"
+#include "thread_support.h"
 
 #include <stddef.h>
-#include <pthread.h>
 
 /* The number of bits a void pointer has.  */
 #define VOIDP_BITS (__CHAR_BIT__ * sizeof (void *))
 
 /* The shared memory part of the allocator.  */
 typedef struct {
-  pthread_mutex_t lock;
+  caf_shmem_mutex lock;
   shared_mem_ptr free_bucket_head[VOIDP_BITS];
 } allocator_shared;
 
diff --git a/libgfortran/caf/shmem/collective_subroutine.c b/libgfortran/caf/shmem/collective_subroutine.c
index 257a048d63d..d261b412a93 100644
--- a/libgfortran/caf/shmem/collective_subroutine.c
+++ b/libgfortran/caf/shmem/collective_subroutine.c
@@ -198,7 +198,7 @@ get_collsub_buf (size_t size)
 {
   void *ret;
 
-  pthread_mutex_lock (&caf_current_team->u.image_info->collsub.mutex);
+  caf_shmem_mutex_lock (&caf_current_team->u.image_info->collsub.mutex);
   /* curr_size is always at least sizeof(double), so we don't need to worry
      about size == 0.  */
   if (size > caf_current_team->u.image_info->collsub.curr_size)
@@ -214,7 +214,7 @@ get_collsub_buf (size_t size)
 
   ret = SHMPTR_AS (void *, caf_current_team->u.image_info->collsub.collsub_buf,
 		   &local->sm);
-  pthread_mutex_unlock (&caf_current_team->u.image_info->collsub.mutex);
+  caf_shmem_mutex_unlock (&caf_current_team->u.image_info->collsub.mutex);
   return ret;
 }
 
diff --git a/libgfortran/caf/shmem/collective_subroutine.h b/libgfortran/caf/shmem/collective_subroutine.h
index 8c37186c867..bdddab07a93 100644
--- a/libgfortran/caf/shmem/collective_subroutine.h
+++ b/libgfortran/caf/shmem/collective_subroutine.h
@@ -36,7 +36,7 @@ typedef struct collsub_shared
   size_t curr_size;
   shared_mem_ptr collsub_buf;
   counter_barrier barrier;
-  pthread_mutex_t mutex;
+  caf_shmem_mutex mutex;
 } collsub_shared;
 
 void collsub_init_supervisor (collsub_shared *, allocator *,
diff --git a/libgfortran/caf/shmem/counter_barrier.c b/libgfortran/caf/shmem/counter_barrier.c
index f78ba7fe852..2cda2afb2ed 100644
--- a/libgfortran/caf/shmem/counter_barrier.c
+++ b/libgfortran/caf/shmem/counter_barrier.c
@@ -34,7 +34,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 static inline void
 lock_counter_barrier (counter_barrier *b)
 {
-  pthread_mutex_lock (&b->mutex);
+  caf_shmem_mutex_lock (&b->mutex);
 }
 
 /* Unlock the associated counter of this barrier.  */
@@ -42,15 +42,15 @@ lock_counter_barrier (counter_barrier *b)
 static inline void
 unlock_counter_barrier (counter_barrier *b)
 {
-  pthread_mutex_unlock (&b->mutex);
+  caf_shmem_mutex_unlock (&b->mutex);
 }
 
 void
 counter_barrier_init (counter_barrier *b, int val)
 {
-  *b = (counter_barrier) {PTHREAD_MUTEX_INITIALIZER, PTHREAD_COND_INITIALIZER,
-			  val, 0, val};
-  initialize_shared_condition (&b->cond);
+  *b = (counter_barrier) {CAF_SHMEM_MUTEX_INITIALIZER,
+			  CAF_SHMEM_COND_INITIALIZER, val, 0, val};
+  initialize_shared_condition (&b->cond, val);
   initialize_shared_mutex (&b->mutex);
 }
 
@@ -60,15 +60,14 @@ counter_barrier_wait (counter_barrier *b)
   int wait_group_beginning;
 
   lock_counter_barrier (b);
-
   wait_group_beginning = b->curr_wait_group;
 
   if ((--b->wait_count) <= 0)
-    pthread_cond_broadcast (&b->cond);
+    caf_shmem_cond_broadcast (&b->cond);
   else
     {
       while (b->wait_count > 0 && b->curr_wait_group == wait_group_beginning)
-	  pthread_cond_wait (&b->cond, &b->mutex);
+	caf_shmem_cond_wait (&b->cond, &b->mutex);
     }
 
   if (b->wait_count <= 0)
@@ -80,13 +79,12 @@ counter_barrier_wait (counter_barrier *b)
   unlock_counter_barrier (b);
 }
 
-
 static inline void
 change_internal_barrier_count (counter_barrier *b, int val)
 {
   b->wait_count += val;
   if (b->wait_count <= 0)
-    pthread_cond_broadcast (&b->cond);
+    caf_shmem_cond_broadcast (&b->cond);
 }
 
 int
@@ -103,19 +101,27 @@ int
 counter_barrier_add (counter_barrier *c, int val)
 {
   int ret;
-  pthread_mutex_lock (&c->mutex);
+  caf_shmem_mutex_lock (&c->mutex);
   ret = counter_barrier_add_locked (c, val);
 
-  pthread_mutex_unlock (&c->mutex);
+  caf_shmem_mutex_unlock (&c->mutex);
   return ret;
 }
 
+void
+counter_barrier_init_add (counter_barrier *b, int val)
+{
+  b->count += val;
+  b->wait_count += val;
+  caf_shmem_cond_update_count (&b->cond, val);
+}
+
 int
 counter_barrier_get_count (counter_barrier *c)
 {
   int ret;
-  pthread_mutex_lock (&c->mutex);
+  caf_shmem_mutex_lock (&c->mutex);
   ret = c->count;
-  pthread_mutex_unlock (&c->mutex);
+  caf_shmem_mutex_unlock (&c->mutex);
   return ret;
 }
diff --git a/libgfortran/caf/shmem/counter_barrier.h b/libgfortran/caf/shmem/counter_barrier.h
index a28c58812a5..ab3d35ada74 100644
--- a/libgfortran/caf/shmem/counter_barrier.h
+++ b/libgfortran/caf/shmem/counter_barrier.h
@@ -25,7 +25,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #ifndef COUNTER_BARRIER_HDR
 #define COUNTER_BARRIER_HDR
 
-#include <pthread.h>
+#include "thread_support.h"
 
 /* Usable as counter barrier and as waitable counter.
    This "class" allows to sync all images acting as a barrier.  For this the
@@ -41,8 +41,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 typedef struct
 {
-  pthread_mutex_t mutex;
-  pthread_cond_t cond;
+  caf_shmem_mutex mutex;
+  caf_shmem_condvar cond;
   volatile int wait_count;
   volatile int curr_wait_group;
   volatile int count;
@@ -65,6 +65,10 @@ int counter_barrier_add_locked (counter_barrier *, int);
 
 int counter_barrier_add (counter_barrier *, int);
 
+/* Add the given number to the counter barrier.  This version does not signal.
+   The mutex needs to be locked for this routine to be safe.  */
+void counter_barrier_init_add (counter_barrier *, int);
+
 /* Get the count of the barrier.  */
 
 int counter_barrier_get_count (counter_barrier *);
diff --git a/libgfortran/caf/shmem/shared_memory.c b/libgfortran/caf/shmem/shared_memory.c
index 2b3666ddd3b..d0789a4bac6 100644
--- a/libgfortran/caf/shmem/shared_memory.c
+++ b/libgfortran/caf/shmem/shared_memory.c
@@ -22,6 +22,10 @@ a copy of the GCC Runtime Library Exception along with this program;
 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 <http://www.gnu.org/licenses/>.  */
 
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
 #include "libgfortran.h"
 #include "allocator.h"
 #include "shared_memory.h"
@@ -30,7 +34,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <fcntl.h>
 #include <stdlib.h>
 #include <string.h>
+#ifdef HAVE_SYS_MMAN_H
 #include <sys/mman.h>
+#elif defined(WIN32)
+#include <Windows.h>
+#include <Memoryapi.h>
+#endif
 #include <unistd.h>
 
 /* This implements shared memory based on POSIX mmap.  We start with
@@ -56,7 +65,11 @@ shared_memory_set_env (pid_t pid)
   char buffer[bufsize];
 
   snprintf (buffer, bufsize, "%d", pid);
+#ifdef HAVE_SETENV
   setenv (ENV_PPID, buffer, 1);
+#else
+  SetEnvironmentVariable (ENV_PPID, buffer);
+#endif
 #undef bufsize
 }
 
@@ -82,7 +95,7 @@ shared_mem_ptr
 shared_memory_get_master (shared_memory_act *mem, size_t size, size_t align)
 {
   if (mem->glbl.meta->master)
-      return (shared_mem_ptr) {mem->glbl.meta->master};
+    return (shared_mem_ptr) {mem->glbl.meta->master};
   else
     {
       ptrdiff_t loc = mem->glbl.meta->used;
@@ -112,7 +125,6 @@ shared_memory_init (shared_memory_act *mem, size_t size)
   char shm_name[NAME_MAX];
   const char *env_val = getenv (ENV_PPID), *base = getenv (ENV_BASE);
   pid_t ppid = getpid ();
-  int shm_fd, res;
   void *base_ptr;
 
   if (env_val)
@@ -131,70 +143,138 @@ shared_memory_init (shared_memory_act *mem, size_t size)
 
   if (!env_val)
     {
-      shm_fd = shm_open (shm_name, O_CREAT | O_RDWR | O_EXCL, 0600);
-      if (shm_fd == -1)
+#ifdef HAVE_MMAP
+      int res;
+
+      mem->shm_fd = shm_open (shm_name, O_CREAT | O_RDWR | O_EXCL, 0600);
+      if (mem->shm_fd == -1)
 	{
 	  perror ("creating shared memory segment failed.");
 	  exit (1);
 	}
 
-      res = ftruncate (shm_fd, size);
+      res = ftruncate (mem->shm_fd, size);
       if (res == -1)
 	{
 	  perror ("resizing shared memory segment failed.");
 	  exit (1);
 	}
+#elif defined(WIN32)
+      mem->shm_fd
+	= CreateFileMapping (INVALID_HANDLE_VALUE, NULL, PAGE_READWRITE,
+			     size >> (sizeof (DWORD) * 8),
+			     (DWORD) (size & ~((DWORD) 0)), shm_name);
+      if (mem->shm_fd == NULL)
+	{
+	  LPVOID lpMsgBuf;
+	  DWORD dw = GetLastError ();
+
+	  if (FormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER
+			       | FORMAT_MESSAGE_FROM_SYSTEM
+			       | FORMAT_MESSAGE_IGNORE_INSERTS,
+			     NULL, dw,
+			     MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),
+			     (LPTSTR) &lpMsgBuf, 0, NULL)
+	      == 0)
+	    {
+	      fprintf (stderr, "formatting the error message failed.\n");
+	      ExitProcess (dw);
+	    }
+
+	  fprintf (stderr, "creating shared memory segment failed: %d, %s\n",
+		   dw, (LPCTSTR) lpMsgBuf);
+
+	  LocalFree (lpMsgBuf);
+	  exit (1);
+	}
+#else
+#error "no way to map shared memory."
+#endif
     }
   else
     {
-      shm_fd = shm_open (shm_name, O_RDWR, 0);
-      if (shm_fd == -1)
+#ifdef HAVE_MMAP
+      mem->shm_fd = shm_open (shm_name, O_RDWR, 0);
+      if (mem->shm_fd == -1)
 	{
 	  perror ("opening shared memory segment failed.");
 	  exit (1);
 	}
+#elif defined(WIN32)
+      mem->shm_fd = OpenFileMapping (FILE_MAP_ALL_ACCESS, FALSE, shm_name);
+      if (mem->shm_fd == NULL)
+	{
+	  perror ("opening shared memory segment failed.");
+	  exit (1);
+	}
+#endif
     }
-
+#ifdef HAVE_MMAP
   mem->glbl.base
-    = mmap (base_ptr, size, PROT_READ | PROT_WRITE, MAP_SHARED, shm_fd, 0);
-  res = close (shm_fd);
+    = mmap (base_ptr, size, PROT_READ | PROT_WRITE, MAP_SHARED, mem->shm_fd, 0);
   if (mem->glbl.base == MAP_FAILED)
     {
       perror ("mmap failed");
       exit (1);
     }
+#elif defined(WIN32)
+  mem->glbl.base
+    = (LPTSTR) MapViewOfFileExNuma (mem->shm_fd, FILE_MAP_ALL_ACCESS, 0, 0,
+				    size, base_ptr, NUMA_NO_PREFERRED_NODE);
+  if (mem->glbl.base == NULL)
+    {
+      perror ("MapViewOfFile failed");
+      exit (1);
+    }
+#endif
   if (!base_ptr)
     {
 #define bufsize 20
       char buffer[bufsize];
 
       snprintf (buffer, bufsize, "%p", mem->glbl.base);
+#ifdef HAVE_SETENV
       setenv (ENV_BASE, buffer, 1);
+#else
+      SetEnvironmentVariable (ENV_BASE, buffer);
+#endif
 #undef bufsize
     }
-  if (res)
-    { // from close()
-      perror ("closing shm file handle failed. Trying to continue...");
-    }
   mem->size = size;
   if (!env_val)
     *mem->glbl.meta
       = (global_shared_memory_meta) {sizeof (global_shared_memory_meta), 0};
-
 }
 
 void
-shared_memory_cleanup (shared_memory_act *)
+shared_memory_cleanup (shared_memory_act *mem)
 {
   char shm_name[NAME_MAX];
-  int res;
 
   snprintf (shm_name, NAME_MAX, "/gfor-shm-%s", shared_memory_get_env ());
+#ifdef HAVE_MMAP
+  int res = munmap (mem->glbl.base, mem->size);
+  if (res)
+    {
+      perror ("unmapping shared memory segment failed");
+    }
+  res = close (mem->shm_fd);
+  if (res)
+    {
+      perror ("closing shm file handle failed. Trying to continue...");
+    }
   res = shm_unlink (shm_name);
   if (res == -1)
     {
       perror ("shm_unlink failed");
       exit (1);
     }
+#elif defined(WIN32)
+  if (!UnmapViewOfFile (mem->glbl.base))
+    {
+      perror ("unmapping shared memory segment failed");
+    }
+  CloseHandle (mem->shm_fd);
+#endif
 }
 #undef NAME_MAX
diff --git a/libgfortran/caf/shmem/shared_memory.h b/libgfortran/caf/shmem/shared_memory.h
index 01ac2811e5d..3d031875ed2 100644
--- a/libgfortran/caf/shmem/shared_memory.h
+++ b/libgfortran/caf/shmem/shared_memory.h
@@ -25,6 +25,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #ifndef SHARED_MEMORY_H
 #define SHARED_MEMORY_H
 
+#include "thread_support.h"
+
 #include <stdlib.h>
 #include <stddef.h>
 #include <unistd.h>
@@ -47,6 +49,7 @@ typedef struct shared_memory_act
     global_shared_memory_meta *meta;
   } glbl;
   size_t size; // const
+  caf_shmem_fd shm_fd;
 } shared_memory_act;
 
 /* A struct to serve as shared memory object.  */
diff --git a/libgfortran/caf/shmem/supervisor.c b/libgfortran/caf/shmem/supervisor.c
index e4310b03e43..c39ffc6715c 100644
--- a/libgfortran/caf/shmem/supervisor.c
+++ b/libgfortran/caf/shmem/supervisor.c
@@ -22,8 +22,6 @@ a copy of the GCC Runtime Library Exception along with this program;
 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 <http://www.gnu.org/licenses/>.  */
 
-#include "config.h"
-
 #include "../caf_error.h"
 #include "supervisor.h"
 #include "teams_mgmt.h"
@@ -38,6 +36,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #elif HAVE_SYS_WAIT_H
 #include <sys/wait.h>
 #endif
+#if !defined(_SC_PAGE_SIZE) && defined(WIN32)
+#include <windows.h>
+#endif
 
 #define GFORTRAN_ENV_NUM_IMAGES "GFORTRAN_NUM_IMAGES"
 #define GFORTRAN_ENV_SHARED_MEMORY_SIZE "GFORTRAN_SHARED_MEMORY_SIZE"
@@ -56,8 +57,13 @@ get_image_num_from_envvar (void)
   int nimages;
   num_images_char = getenv (GFORTRAN_ENV_NUM_IMAGES);
   if (!num_images_char)
-    return sysconf (_SC_NPROCESSORS_ONLN); /* TODO: Make portable.  */
-  /* TODO: Error checking.  */
+#ifdef _SC_NPROCESSORS_ONLN
+    return sysconf (_SC_NPROCESSORS_ONLN);
+#elif defined(WIN32)
+    num_images_char = getenv ("NUMBER_OF_PROCESSORS");
+#else
+#error "Unsupported system: No known way to get number of cores!"
+#endif
   nimages = atoi (num_images_char);
   return nimages;
 }
@@ -105,7 +111,12 @@ get_memory_size_from_envvar (void)
       if (sizeof (size_t) == 4)
 	sz = ((size_t) 1) << 28;
       else
+#ifndef WIN32
 	sz = ((size_t) 1) << 34;
+#else
+	/* Use 1GB on Windows.  */
+	sz = ((size_t) 1) << 30;
+#endif
     }
   return sz;
 }
@@ -146,7 +157,19 @@ ensure_shmem_initialization (void)
     return;
 
   local = malloc (sizeof (image_local));
+#if defined(_SC_PAGE_SIZE)
   pagesize = sysconf (_SC_PAGE_SIZE);
+#elif defined(WIN32)
+  {
+    SYSTEM_INFO si;
+    GetNativeSystemInfo (&si);
+    pagesize = si.dwAllocationGranularity;
+  }
+#else
+#warning                                                                       \
+  "Unsupported system: No known way to get memory page size. Assuming 4k!"
+  pagesize = 4096;
+#endif
   shmem_size = round_to_pagesize (get_memory_size_from_envvar ());
   local->total_num_images = get_image_num_from_envvar ();
   shared_memory_init (&local->sm, shmem_size);
@@ -199,6 +222,7 @@ ensure_shmem_initialization (void)
     {
       this_image = (image) {-1, get_supervisor ()};
       this_image.supervisor->magic_number = SUPERVISOR_MAGIC_NUM;
+      thread_support_init_supervisor ();
       counter_barrier_init (&this_image.supervisor->num_active_images,
 			    local->total_num_images);
       alloc_init_supervisor (&local->ai, &local->sm);
@@ -206,16 +230,31 @@ ensure_shmem_initialization (void)
     }
 }
 
+#if !defined(environ)
 extern char **environ;
+#endif
 
+/* argc and argv may not be used on certain OSes.  Flag them unused therefore.
+ */
 int
-supervisor_main_loop (int *argc __attribute__ ((unused)), char ***argv,
-		      int *exit_code)
+supervisor_main_loop (int *argc __attribute__ ((unused)),
+		      char ***argv __attribute__ ((unused)), int *exit_code)
 {
   supervisor *m;
-  pid_t new_pid, finished_pid;
   image im;
+#if defined(WIN32) && !defined(HAVE_FORK)
+  HANDLE *process_handles = malloc (sizeof (HANDLE) * local->total_num_images),
+	 *thread_handles = malloc (sizeof (HANDLE) * local->total_num_images),
+	 *waiting_handles = malloc (sizeof (HANDLE) * local->total_num_images);
+  int count_waiting = local->total_num_images;
+  LPTCH *envs = malloc (sizeof (LPTCH) * local->total_num_images);
+  LPTSTR currentDir;
+  DWORD cdLen = GetCurrentDirectory (0, NULL);
+  currentDir = malloc (cdLen);
+  GetCurrentDirectory (cdLen, currentDir);
+#else
   int chstatus;
+#endif
 
   *exit_code = 0;
   shared_memory_set_env (getpid ());
@@ -223,6 +262,8 @@ supervisor_main_loop (int *argc __attribute__ ((unused)), char ***argv,
 
   for (im.image_num = 0; im.image_num < local->total_num_images; im.image_num++)
     {
+#ifdef HAVE_FORK
+      caf_shmem_pid new_pid;
       if ((new_pid = fork ()))
 	{
 	  if (new_pid == -1)
@@ -247,10 +288,63 @@ supervisor_main_loop (int *argc __attribute__ ((unused)), char ***argv,
 	  execve ((*argv)[0], *argv, new_env);
 	  return 1;
 	}
+#elif defined(WIN32)
+      LPTCH new_env;
+      size_t n = 0, es;
+      STARTUPINFO si;
+      DWORD dwFlags = 0;
+      PROCESS_INFORMATION pi;
+      LPTCH env = GetEnvironmentStrings ();
+
+      ZeroMemory (&si, sizeof (si));
+      si.cb = sizeof (si);
+      ZeroMemory (&pi, sizeof (pi));
+
+      /* Count the number of characters in the current environment.  */
+      for (LPTSTR e = (LPTSTR) env; *e; es = lstrlen (e) + 1, e += es, n += es)
+	;
+      new_env = (LPCH) malloc (n + 32 * sizeof (TCHAR));
+      memcpy (new_env, env, n);
+      snprintf (&((TCHAR *) new_env)[n], 32, "%s=%d%c", GFORTRAN_ENV_IMAGE_NUM,
+		im.image_num, (char) 0);
+      if (!CreateProcessA (NULL, GetCommandLine (), NULL, NULL, FALSE, dwFlags,
+			   new_env, currentDir, &si, &pi))
+	{
+	  LPVOID lpMsgBuf;
+	  DWORD dw = GetLastError ();
+
+	  if (FormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER
+			       | FORMAT_MESSAGE_FROM_SYSTEM
+			       | FORMAT_MESSAGE_IGNORE_INSERTS,
+			     NULL, dw,
+			     MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),
+			     (LPTSTR) &lpMsgBuf, 0, NULL)
+	      == 0)
+	    {
+	      fprintf (stderr, "formatting the error message failed.\n");
+	      ExitProcess (dw);
+	    }
+
+	  fprintf (stderr, "error spawning child: %ld, %s\n", dw,
+		   (LPCTSTR) lpMsgBuf);
+
+	  LocalFree (lpMsgBuf);
+	  exit (1);
+	}
+      m->images[im.image_num] = (image_tracker) {pi.hProcess, IMAGE_OK};
+      process_handles[im.image_num] = waiting_handles[im.image_num]
+	= pi.hProcess;
+      thread_handles[im.image_num] = pi.hThread;
+      envs[im.image_num] = new_env;
+#else
+#error "no way known to start child processes."
+#endif
     }
-  for (int j, i = 0; i < local->total_num_images; i++)
+  for (int i = 0; i < local->total_num_images; i++)
     {
-      finished_pid = wait (&chstatus);
+#ifdef HAVE_FORK
+      caf_shmem_pid finished_pid = wait (&chstatus);
+      int j;
       if (WIFEXITED (chstatus) && !WEXITSTATUS (chstatus))
 	{
 	  for (j = 0;
@@ -303,10 +397,77 @@ supervisor_main_loop (int *argc __attribute__ ((unused)), char ***argv,
 	}
       /* Trigger waiting sync images aka sync_table.  */
       for (j = 0; j < local->total_num_images; j++)
-	pthread_cond_signal (&SHMPTR_AS (pthread_cond_t *,
-					 m->sync_shared.sync_images_cond_vars,
-					 &local->sm)[j]);
+	caf_shmem_cond_signal (&SHMPTR_AS (caf_shmem_condvar *,
+					   m->sync_shared.sync_images_cond_vars,
+					   &local->sm)[j]);
       counter_barrier_add (&m->num_active_images, -1);
+#elif defined(WIN32)
+      DWORD res = WaitForMultipleObjects (count_waiting, waiting_handles, FALSE,
+					  INFINITE);
+      HANDLE cand;
+      bool progress = false;
+      DWORD process_exit_code;
+      if (res == WAIT_FAILED)
+	caf_runtime_error ("waiting for process termination failed.");
+      int index = res - WAIT_OBJECT_0, finished_process;
+      bool fail;
+
+      do
+	{
+	  cand = waiting_handles[index];
+	  for (finished_process = 0;
+	       finished_process < local->total_num_images
+	       && cand != process_handles[finished_process];
+	       ++finished_process)
+	    ;
+
+	  GetExitCodeProcess (cand, &process_exit_code);
+	  fail = process_exit_code != 0;
+	  fprintf (stderr, "terminating process %d with fail status %d (%ld)\n",
+		   finished_process, fail, process_exit_code);
+	  if (finished_process < local->total_num_images)
+	    {
+	      CloseHandle (process_handles[finished_process]);
+	      process_handles[finished_process] = NULL;
+	      CloseHandle (thread_handles[finished_process]);
+	      FreeEnvironmentStrings (envs[finished_process]);
+	      if (fail)
+		{
+		  m->images[finished_process].status = IMAGE_FAILED;
+		  atomic_fetch_add (&m->failed_images, 1);
+		  if (*exit_code < process_exit_code)
+		    *exit_code = process_exit_code;
+		}
+	      else
+		{
+		  m->images[finished_process].status = IMAGE_SUCCESS;
+		  atomic_fetch_add (&m->finished_images, 1);
+		}
+	    }
+	  memmove (&waiting_handles[index], &waiting_handles[index + 1],
+		   sizeof (HANDLE) * (count_waiting - index - 1));
+	  --count_waiting;
+	  counter_barrier_add (&m->num_active_images, -1);
+
+	  /* Check if more than one process has terminated already.  */
+	  progress = false;
+	  for (index = 0; index < count_waiting; ++index)
+	    if (WaitForSingleObject (waiting_handles[index], 0)
+		== WAIT_OBJECT_0)
+	      {
+		progress = true;
+		++i;
+		break;
+	      }
+	}
+      while (progress && count_waiting > 0);
+#endif
     }
+
+#if defined(WIN32) && !defined(HAVE_FORK)
+  free (process_handles);
+  free (thread_handles);
+  free (envs);
+#endif
   return 0;
 }
diff --git a/libgfortran/caf/shmem/supervisor.h b/libgfortran/caf/shmem/supervisor.h
index 7afb8269674..7e5e19702e4 100644
--- a/libgfortran/caf/shmem/supervisor.h
+++ b/libgfortran/caf/shmem/supervisor.h
@@ -25,6 +25,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #ifndef SUPERVISOR_H
 #define SUPERVISOR_H
 
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
 #include "caf/libcaf.h"
 #include "alloc.h"
 #include "collective_subroutine.h"
@@ -42,7 +46,7 @@ typedef enum
 
 typedef struct
 {
-  pid_t pid;
+  caf_shmem_pid pid;
   image_status status;
 } image_tracker;
 
@@ -56,7 +60,10 @@ typedef struct supervisor
   atomic_int failed_images;
   atomic_int finished_images;
   counter_barrier num_active_images;
-  pthread_mutex_t image_tracker_lock;
+  caf_shmem_mutex image_tracker_lock;
+#ifdef WIN32
+  size_t global_used_handles;
+#endif
   image_tracker images[];
 } supervisor;
 
diff --git a/libgfortran/caf/shmem/sync.c b/libgfortran/caf/shmem/sync.c
index a456244629c..e1020a1e864 100644
--- a/libgfortran/caf/shmem/sync.c
+++ b/libgfortran/caf/shmem/sync.c
@@ -33,13 +33,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 static inline void
 lock_table (sync_t *si)
 {
-  pthread_mutex_lock (&si->cis->sync_images_table_lock);
+  caf_shmem_mutex_lock (&si->cis->sync_images_table_lock);
 }
 
 static inline void
 unlock_table (sync_t *si)
 {
-  pthread_mutex_unlock (&si->cis->sync_images_table_lock);
+  caf_shmem_mutex_unlock (&si->cis->sync_images_table_lock);
 }
 
 void
@@ -48,7 +48,7 @@ sync_init (sync_t *si, shared_memory sm)
   *si = (sync_t) {
     &this_image.supervisor->sync_shared,
     SHMPTR_AS (int *, this_image.supervisor->sync_shared.sync_images_table, sm),
-    SHMPTR_AS (pthread_cond_t *,
+    SHMPTR_AS (caf_shmem_condvar *,
 	       this_image.supervisor->sync_shared.sync_images_cond_vars, sm)};
 }
 
@@ -61,7 +61,7 @@ sync_init_supervisor (sync_t *si, alloc *ai)
   si->cis = &this_image.supervisor->sync_shared;
 
   initialize_shared_mutex (&si->cis->event_lock);
-  initialize_shared_condition (&si->cis->event_cond);
+  initialize_shared_condition (&si->cis->event_cond, num_images);
 
   initialize_shared_mutex (&si->cis->sync_images_table_lock);
 
@@ -69,14 +69,14 @@ sync_init_supervisor (sync_t *si, alloc *ai)
     = allocator_shared_malloc (alloc_get_allocator (ai), table_size_in_bytes);
   si->cis->sync_images_cond_vars
     = allocator_shared_malloc (alloc_get_allocator (ai),
-			       sizeof (pthread_cond_t) * num_images);
+			       sizeof (caf_shmem_condvar) * num_images);
 
   si->table = SHMPTR_AS (int *, si->cis->sync_images_table, ai->mem);
   si->triggers
-    = SHMPTR_AS (pthread_cond_t *, si->cis->sync_images_cond_vars, ai->mem);
+    = SHMPTR_AS (caf_shmem_condvar *, si->cis->sync_images_cond_vars, ai->mem);
 
   for (int i = 0; i < num_images; i++)
-    initialize_shared_condition (&si->triggers[i]);
+    initialize_shared_condition (&si->triggers[i], num_images);
 
   memset (si->table, 0, table_size_in_bytes);
 }
@@ -103,7 +103,7 @@ sync_table (sync_t *si, int *images, int size)
       for (i = 0; i < size; ++i)
 	{
 	  ++table[images[i] + img_c * this_image.image_num];
-	  pthread_cond_signal (&si->triggers[images[i]]);
+	  caf_shmem_cond_signal (&si->triggers[images[i]]);
 	}
       for (;;)
 	{
@@ -114,7 +114,7 @@ sync_table (sync_t *si, int *images, int size)
 	      break;
 	  if (i == size)
 	    break;
-	  pthread_cond_wait (&si->triggers[this_image.image_num],
+	  caf_shmem_cond_wait (&si->triggers[this_image.image_num],
 			     &si->cis->sync_images_table_lock);
 	}
     }
@@ -127,7 +127,7 @@ sync_table (sync_t *si, int *images, int size)
 	  if (this_image.supervisor->images[map[i]].status != IMAGE_OK)
 	    continue;
 	  ++table[map[i] + size * this_image.image_num];
-	  pthread_cond_signal (&si->triggers[map[i]]);
+	  caf_shmem_cond_signal (&si->triggers[map[i]]);
 	}
       for (;;)
 	{
@@ -138,7 +138,7 @@ sync_table (sync_t *si, int *images, int size)
 	      break;
 	  if (i == size)
 	    break;
-	  pthread_cond_wait (&si->triggers[this_image.image_num],
+	  caf_shmem_cond_wait (&si->triggers[this_image.image_num],
 			     &si->cis->sync_images_table_lock);
 	}
     }
@@ -160,23 +160,23 @@ sync_team (caf_shmem_team_t team)
 void
 lock_event (sync_t *si)
 {
-  pthread_mutex_lock (&si->cis->event_lock);
+  caf_shmem_mutex_lock (&si->cis->event_lock);
 }
 
 void
 unlock_event (sync_t *si)
 {
-  pthread_mutex_unlock (&si->cis->event_lock);
+  caf_shmem_mutex_unlock (&si->cis->event_lock);
 }
 
 void
 event_post (sync_t *si)
 {
-  pthread_cond_broadcast (&si->cis->event_cond);
+  caf_shmem_cond_broadcast (&si->cis->event_cond);
 }
 
 void
 event_wait (sync_t *si)
 {
-  pthread_cond_wait (&si->cis->event_cond, &si->cis->event_lock);
+  caf_shmem_cond_wait (&si->cis->event_cond, &si->cis->event_lock);
 }
diff --git a/libgfortran/caf/shmem/sync.h b/libgfortran/caf/shmem/sync.h
index a3e586bca24..a6d20614b67 100644
--- a/libgfortran/caf/shmem/sync.h
+++ b/libgfortran/caf/shmem/sync.h
@@ -28,13 +28,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "alloc.h"
 #include "counter_barrier.h"
 
-#include <pthread.h>
-
 typedef struct {
   /* Mutex and condition variable needed for signaling events.  */
-  pthread_mutex_t event_lock;
-  pthread_cond_t event_cond;
-  pthread_mutex_t sync_images_table_lock;
+  caf_shmem_mutex event_lock;
+  caf_shmem_condvar event_cond;
+  caf_shmem_mutex sync_images_table_lock;
   shared_mem_ptr sync_images_table;
   shared_mem_ptr sync_images_cond_vars;
 } sync_shared;
@@ -42,10 +40,10 @@ typedef struct {
 typedef struct {
   sync_shared *cis;
   int *table; // we can cache the table and the trigger pointers here
-  pthread_cond_t *triggers;
+  caf_shmem_condvar *triggers;
 } sync_t;
 
-typedef pthread_mutex_t lock_t;
+typedef caf_shmem_mutex lock_t;
 
 typedef int event_t;
 
diff --git a/libgfortran/caf/shmem/teams_mgmt.c b/libgfortran/caf/shmem/teams_mgmt.c
index 44a34d727c3..9bf8db2302c 100644
--- a/libgfortran/caf/shmem/teams_mgmt.c
+++ b/libgfortran/caf/shmem/teams_mgmt.c
@@ -31,7 +31,7 @@ caf_shmem_team_t caf_teams_formed = NULL;
 void
 update_teams_images (caf_shmem_team_t team)
 {
-  pthread_mutex_lock (&team->u.image_info->image_count.mutex);
+  caf_shmem_mutex_lock (&team->u.image_info->image_count.mutex);
   if (team->u.image_info->num_term_images
       != this_image.supervisor->finished_images
 	   + this_image.supervisor->failed_images)
@@ -52,7 +52,7 @@ update_teams_images (caf_shmem_team_t team)
 				   old_num
 				     - team->u.image_info->num_term_images);
     }
-  pthread_mutex_unlock (&team->u.image_info->image_count.mutex);
+  caf_shmem_mutex_unlock (&team->u.image_info->image_count.mutex);
 }
 
 void
diff --git a/libgfortran/caf/shmem/thread_support.c b/libgfortran/caf/shmem/thread_support.c
old mode 100644
new mode 100755
index 572f39400b3..e2c53627c2f
--- a/libgfortran/caf/shmem/thread_support.c
+++ b/libgfortran/caf/shmem/thread_support.c
@@ -28,6 +28,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <stdlib.h>
 #include <stdio.h>
 
+#if !defined(WIN32) && !defined(__CYGWIN__)
+#include <pthread.h>
+
 #define ERRCHECK(a)                                                            \
   do                                                                           \
     {                                                                          \
@@ -42,7 +45,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
   while (0)
 
 void
-initialize_shared_mutex (pthread_mutex_t *mutex)
+initialize_shared_mutex (caf_shmem_mutex *mutex)
 {
   pthread_mutexattr_t mattr;
   ERRCHECK (pthread_mutexattr_init (&mattr));
@@ -52,18 +55,18 @@ initialize_shared_mutex (pthread_mutex_t *mutex)
 }
 
 void
-initialize_shared_errorcheck_mutex (pthread_mutex_t *mutex)
+initialize_shared_errorcheck_mutex (caf_shmem_mutex *mutex)
 {
   pthread_mutexattr_t mattr;
   ERRCHECK (pthread_mutexattr_init (&mattr));
-  ERRCHECK (pthread_mutexattr_setpshared (&mattr, PTHREAD_PROCESS_SHARED));
   ERRCHECK (pthread_mutexattr_settype (&mattr, PTHREAD_MUTEX_ERRORCHECK));
+  ERRCHECK (pthread_mutexattr_setpshared (&mattr, PTHREAD_PROCESS_SHARED));
   ERRCHECK (pthread_mutex_init (mutex, &mattr));
   ERRCHECK (pthread_mutexattr_destroy (&mattr));
 }
 
 void
-initialize_shared_condition (pthread_cond_t *cond)
+initialize_shared_condition (caf_shmem_condvar *cond, const int)
 {
   pthread_condattr_t cattr;
   ERRCHECK (pthread_condattr_init (&cattr));
@@ -71,3 +74,302 @@ initialize_shared_condition (pthread_cond_t *cond)
   ERRCHECK (pthread_cond_init (cond, &cattr));
   ERRCHECK (pthread_condattr_destroy (&cattr));
 }
+#else
+#include "../caf_error.h"
+#include "supervisor.h"
+#include "teams_mgmt.h"
+#include <windows.h>
+#include <assert.h>
+
+static HANDLE *handles = NULL;
+static size_t cap_handles = 0;
+
+static const int ULONGBITS = sizeof (unsigned long) << 3; // *8
+
+static size_t
+smax (size_t a, size_t b)
+{
+  return a < b ? b : a;
+}
+
+static HANDLE
+get_handle (const size_t id, const char t)
+{
+  const int add = t == 'c' ? 1 : 0;
+  while (id + add >= cap_handles)
+    {
+      cap_handles += 1024;
+      if (handles)
+	handles = realloc (handles, sizeof (HANDLE) * cap_handles);
+      else
+	handles = malloc (sizeof (HANDLE) * cap_handles);
+      if (!handles)
+	caf_runtime_error (
+	  "can not get buffer for synchronication objects, aborting");
+
+      memset (&handles[cap_handles - 1024], 0, sizeof (HANDLE) * 1024);
+    }
+  if (!handles[id])
+    {
+      static char *pid = NULL;
+      char name[MAX_PATH];
+
+      if (!pid)
+	pid = shared_memory_get_env ();
+      snprintf (name, MAX_PATH, "Global_gfortran-%s-%c-%zd", pid, t, id);
+      switch (t)
+	{
+	case 'm':
+	  handles[id] = CreateMutex (NULL, false, name);
+	  break;
+	case 'c':
+	  {
+	    handles[id] = CreateSemaphore (NULL, 0, __INT_MAX__, name);
+	    snprintf (name, MAX_PATH, "Global_gfortran-%s-%c-%zd_lock", pid, t,
+		      id);
+	    handles[id + 1] = CreateSemaphore (NULL, 1, 1, name);
+	    this_image.supervisor->global_used_handles
+	      = smax (this_image.supervisor->global_used_handles, id + 2);
+	    break;
+	  }
+	default:
+	  caf_runtime_error ("Unknown handle type %c", t);
+	  exit (1);
+	}
+      if (handles[id] == NULL)
+	{
+	  caf_runtime_error (
+	    "Could not create synchronisation object, error: %d",
+	    GetLastError ());
+	  return NULL;
+	}
+
+      this_image.supervisor->global_used_handles
+	= smax (this_image.supervisor->global_used_handles, id + 1);
+    }
+
+  return handles[id];
+}
+
+static HANDLE
+get_mutex (caf_shmem_mutex *m)
+{
+  return get_handle (m->id, 'm');
+}
+
+static HANDLE
+get_condvar (caf_shmem_condvar *cv)
+{
+  return get_handle (cv->id, 'c');
+}
+
+void
+thread_support_init_supervisor (void)
+{
+  if (local->total_num_images > ULONGBITS * MAX_NUM_SIGNALED)
+    caf_runtime_error ("Maximum number of supported images is %zd.",
+		       ULONGBITS * MAX_NUM_SIGNALED);
+  this_image.supervisor->global_used_handles = 0;
+}
+
+int
+caf_shmem_mutex_lock (caf_shmem_mutex *m)
+{
+  HANDLE mutex = get_mutex (m);
+  DWORD res = WaitForSingleObject (mutex, INFINITE);
+
+  /* Return zero on success.  */
+  return res != WAIT_OBJECT_0;
+}
+
+int
+caf_shmem_mutex_trylock (caf_shmem_mutex *m)
+{
+  HANDLE mutex = get_mutex (m);
+  DWORD res = WaitForSingleObject (mutex, 0);
+
+  return res == WAIT_OBJECT_0 ? 0 : EBUSY;
+}
+
+int
+caf_shmem_mutex_unlock (caf_shmem_mutex *m)
+{
+  HANDLE mutex = get_mutex (m);
+  BOOL res = ReleaseMutex (mutex);
+
+  if (!res)
+    {
+      LPVOID lpMsgBuf;
+      DWORD dw = GetLastError ();
+
+      if (FormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER
+			   | FORMAT_MESSAGE_FROM_SYSTEM
+			   | FORMAT_MESSAGE_IGNORE_INSERTS,
+			 NULL, dw, MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),
+			 (LPTSTR) &lpMsgBuf, 0, NULL)
+	  == 0)
+	{
+	  fprintf (stderr, "%d: formatting the error message failed.\n",
+		   this_image.image_num);
+	  ExitProcess (dw);
+	}
+
+      fprintf (stderr, "%d: unlock mutex failed: %d, %s\n",
+	       this_image.image_num, dw, (LPCTSTR) lpMsgBuf);
+
+      LocalFree (lpMsgBuf);
+    }
+  return res ? 0 : EPERM;
+}
+
+static bool
+bm_is_set (volatile unsigned long mask[], const int b)
+{
+  return (mask[b / ULONGBITS] & (1UL << (b % ULONGBITS))) != 0;
+}
+
+static void
+bm_clear_bit (volatile unsigned long mask[], const int b)
+{
+  mask[b / ULONGBITS] &= ~(1UL << (b % ULONGBITS));
+}
+
+static void
+bm_set_mask (volatile unsigned long mask[], const int size)
+{
+  const int entries = size / ULONGBITS;
+  const int rem = size % ULONGBITS;
+  int i = 0;
+  assert (entries >= 0);
+
+  for (; i < entries; ++i)
+    mask[i] = ~0UL;
+  if (rem != 0)
+    mask[i] = ~0UL >> (ULONGBITS - rem);
+}
+
+__attribute_used__ static bool
+bm_is_none (volatile unsigned long mask[], const int size)
+{
+  const int entries = size / ULONGBITS;
+  const int rem = size % ULONGBITS;
+  int i = 0;
+  for (; i < entries; ++i)
+    if (mask[i] != 0)
+      return false;
+
+  return rem == 0 || ((mask[i] & (~0UL >> (ULONGBITS - rem))) == 0);
+}
+
+void
+caf_shmem_cond_wait (caf_shmem_condvar *cv, caf_shmem_mutex *m)
+{
+  HANDLE mutex = get_mutex (m), condvar = get_condvar (cv),
+	 lock = get_handle (cv->id + 1, 'c');
+  HANDLE entry[3] = {mutex, condvar, lock};
+  int res;
+
+  WaitForSingleObject (lock, INFINITE);
+  for (;;)
+    {
+      if (bm_is_set (cv->signaled, this_image.image_num) || cv->any)
+	{
+	  break;
+	}
+      ReleaseMutex (mutex);
+      ReleaseSemaphore (lock, 1, NULL);
+      res = WaitForMultipleObjects (3, entry, true, INFINITE);
+      if (res != WAIT_OBJECT_0)
+	{
+	  fprintf (stderr, "%d: failed to get all wait for: %d\n",
+		   this_image.image_num, res);
+	  fflush (stderr);
+	}
+      ReleaseSemaphore (condvar, 1, NULL);
+    }
+  res = WaitForSingleObject (condvar, INFINITE);
+  if (res != WAIT_OBJECT_0)
+    {
+      fprintf (stderr, "%d: failed to get condvar: %d\n", this_image.image_num,
+	       res);
+      fflush (stderr);
+    }
+
+  bm_clear_bit (cv->signaled, this_image.image_num);
+  cv->any = 0;
+  ReleaseSemaphore (lock, 1, NULL);
+}
+
+void
+caf_shmem_cond_broadcast (caf_shmem_condvar *cv)
+{
+  HANDLE condvar = get_condvar (cv), lock = get_handle (cv->id + 1, 'c');
+
+  WaitForSingleObject (lock, INFINITE);
+  bm_set_mask (cv->signaled, cv->size);
+  bm_clear_bit (cv->signaled, this_image.image_num);
+
+  ReleaseSemaphore (condvar, cv->size, NULL);
+  ReleaseSemaphore (lock, 1, NULL);
+}
+
+void
+caf_shmem_cond_signal (caf_shmem_condvar *cv)
+{
+  HANDLE condvar = get_condvar (cv), lock = get_handle (cv->id + 1, 'c');
+
+  if (caf_current_team)
+    {
+      WaitForSingleObject (lock, INFINITE);
+    }
+  else
+    return;
+  /* The first image is zero, which wouldn't allow it to signal.  */
+  cv->any = this_image.image_num + 1;
+  ReleaseSemaphore (condvar, 1, NULL);
+  ReleaseSemaphore (lock, 1, NULL);
+}
+
+void
+caf_shmem_cond_update_count (caf_shmem_condvar *cv, int val)
+{
+  cv->size += val;
+}
+
+void
+initialize_shared_mutex (caf_shmem_mutex *m)
+{
+  *m = (caf_shmem_mutex) {this_image.supervisor->global_used_handles};
+
+  get_mutex (m);
+}
+
+void
+initialize_shared_errorcheck_mutex (caf_shmem_mutex *m)
+{
+  *m = (caf_shmem_mutex) {this_image.supervisor->global_used_handles};
+
+  get_mutex (m);
+}
+
+void
+initialize_shared_condition (caf_shmem_condvar *cv, const int size)
+{
+  *cv = (caf_shmem_condvar) {this_image.supervisor->global_used_handles,
+			     0,
+			     size,
+			     {}};
+
+  memset ((void *) cv->signaled, 0, sizeof (unsigned long) * MAX_NUM_SIGNALED);
+  get_condvar (cv);
+  assert (bm_is_none (cv->signaled, cv->size));
+}
+
+void
+thread_support_cleanup (void)
+{
+  for (size_t i = 0; i < this_image.supervisor->global_used_handles; ++i)
+    if (handles[i])
+      CloseHandle (handles[i]);
+}
+#endif
diff --git a/libgfortran/caf/shmem/thread_support.h b/libgfortran/caf/shmem/thread_support.h
old mode 100644
new mode 100755
index e70b4b83c7d..351cdbbb868
--- a/libgfortran/caf/shmem/thread_support.h
+++ b/libgfortran/caf/shmem/thread_support.h
@@ -25,14 +25,89 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #ifndef THREAD_SUPPORT_H
 #define THREAD_SUPPORT_H
 
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#ifndef WIN32
+#include <sys/types.h>
+
+typedef pid_t caf_shmem_pid;
+typedef int caf_shmem_fd;
+#else
+#include <handleapi.h>
+
+typedef HANDLE caf_shmem_pid;
+typedef HANDLE caf_shmem_fd;
+#endif
+
+#if !defined(WIN32) && !defined(__CYGWIN__)
 #include <pthread.h>
 
+typedef pthread_mutex_t caf_shmem_mutex;
+typedef pthread_cond_t caf_shmem_condvar;
+
+#define CAF_SHMEM_MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER
+#define CAF_SHMEM_COND_INITIALIZER PTHREAD_COND_INITIALIZER
+
+#define thread_support_init_supervisor() (void) 0
+
+#define caf_shmem_mutex_lock pthread_mutex_lock
+#define caf_shmem_mutex_trylock pthread_mutex_trylock
+#define caf_shmem_mutex_unlock pthread_mutex_unlock
+
+#define caf_shmem_cond_wait pthread_cond_wait
+#define caf_shmem_cond_broadcast pthread_cond_broadcast
+#define caf_shmem_cond_signal pthread_cond_signal
+#define caf_shmem_cond_update_count(c, v) (void) 0
+
+#define thread_support_cleanup() (void) 0
+#else
+#include <synchapi.h>
+#include <stddef.h>
+
+typedef struct caf_shmem_mutex
+{
+  size_t id;
+} caf_shmem_mutex;
+
+#define MAX_NUM_SIGNALED 8
+
+typedef struct caf_shmem_condvar
+{
+  size_t id;
+  volatile int any;
+  int size;
+  volatile unsigned long signaled[MAX_NUM_SIGNALED];
+} caf_shmem_condvar;
+
+#define CAF_SHMEM_MUTEX_INITIALIZER (caf_shmem_mutex){0}
+#define CAF_SHMEM_COND_INITIALIZER                                             \
+  (caf_shmem_condvar)                                                          \
+  {                                                                            \
+    0, 0, 0, {}                                                                \
+  }
+
+void thread_support_init_supervisor (void);
+
+int caf_shmem_mutex_lock (caf_shmem_mutex *);
+int caf_shmem_mutex_trylock (caf_shmem_mutex *);
+int caf_shmem_mutex_unlock (caf_shmem_mutex *);
+
+void caf_shmem_cond_wait (caf_shmem_condvar *, caf_shmem_mutex *);
+void caf_shmem_cond_broadcast (caf_shmem_condvar *);
+void caf_shmem_cond_signal (caf_shmem_condvar *);
+void caf_shmem_cond_update_count (caf_shmem_condvar *, int);
+
+void thread_support_cleanup (void);
+#endif
+
 /* Support routines to setup pthread structs in shared memory.  */
 
-void initialize_shared_mutex (pthread_mutex_t *);
+void initialize_shared_mutex (caf_shmem_mutex *);
 
-void initialize_shared_errorcheck_mutex (pthread_mutex_t *);
+void initialize_shared_errorcheck_mutex (caf_shmem_mutex *);
 
-void initialize_shared_condition (pthread_cond_t *);
+void initialize_shared_condition (caf_shmem_condvar *, const int size);
 
 #endif