https://gcc.gnu.org/g:efb497c23a6f4109bf8794342617cbc161c08301
commit r16-7729-gefb497c23a6f4109bf8794342617cbc161c08301 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: --- libgfortran/caf/shmem.c | 79 ++++--- libgfortran/caf/shmem/alloc.c | 2 +- libgfortran/caf/shmem/allocator.c | 4 +- libgfortran/caf/shmem/allocator.h | 4 +- libgfortran/caf/shmem/collective_subroutine.c | 4 +- libgfortran/caf/shmem/collective_subroutine.h | 2 +- libgfortran/caf/shmem/counter_barrier.c | 34 +-- libgfortran/caf/shmem/counter_barrier.h | 10 +- libgfortran/caf/shmem/shared_memory.c | 114 ++++++++-- libgfortran/caf/shmem/shared_memory.h | 3 + libgfortran/caf/shmem/supervisor.c | 185 ++++++++++++++- libgfortran/caf/shmem/supervisor.h | 11 +- libgfortran/caf/shmem/sync.c | 30 +-- libgfortran/caf/shmem/sync.h | 12 +- libgfortran/caf/shmem/teams_mgmt.c | 4 +- libgfortran/caf/shmem/thread_support.c | 310 +++++++++++++++++++++++++- libgfortran/caf/shmem/thread_support.h | 81 ++++++- 17 files changed, 774 insertions(+), 115 deletions(-) diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c index b8d92d657f5f..266feab3e456 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 fecf97c03ffa..ea250ac6922f 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 3ea4d50e045a..2a22abb2a80e 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 53b6abeeba11..0cf31ea837a7 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 257a048d63d5..d261b412a932 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 8c37186c867b..bdddab07a930 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 f78ba7fe852d..2cda2afb2ed7 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 a28c58812a54..ab3d35ada74c 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 2b3666ddd3b9..d0789a4bac6f 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 01ac2811e5d6..3d031875ed2f 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 e4310b03e43d..c39ffc6715c9 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 7afb82696749..7e5e19702e45 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 a456244629ca..e1020a1e8640 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 a3e586bca244..a6d20614b675 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 44a34d727c36..9bf8db2302c2 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 572f39400b38..e2c53627c2f5 --- 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 e70b4b83c7d6..351cdbbb8687 --- 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
