anil.recoil.org / unpac-unpac
The unpac monorepo manager self-hosting as a monorepo using unpac
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

Implement concurrency primitives using WinAPI

Don't include pthread.h on Windows to avoid using pthreads emulation
libraries (such as winpthreads) by mistake.

Functions from platform.c that used pthreads are moved to unix.c,
their Windows counterparts are implemented in win32.c. Introduce a new
sync_win32.h header, counterpart of sync_unix.h. Use the
caml_plat_thread and caml_plat_thread_attr to abstract over the
system's thread id/handle type and thread attributes.

Use pairs of SRWLOCK and CONDITION_VARIABLES to replace pthreads
mutexes and condition variables.

POSIX states:

> The pthread_mutex_lock() function shall fail if:
> [EDEADLK]
> The mutex type is PTHREAD_MUTEX_ERRORCHECK and the current thread
> already owns the mutex.

The Windows documentation states:

> Exclusive mode SRW locks cannot be acquired recursively. If a thread
> tries to acquire a lock that it already holds, that attempt will
> [...] deadlock (for AcquireSRWLockExclusive).

Deadlocks caused by recursive attemps to lock cannot be detected on
Windows.

Antonin Décimo ebffe6d0 0ad6a14b

+254 -264
+5
Changes
··· 124 124 continuations without calling `caml_continuation_use`. 125 125 (Max Slater, review by Nick Barnes and Stephen Dolan) 126 126 127 + - #13416: Implement concurrency primitives using WinAPI instead of 128 + winpthreads on Windows. 129 + (Antonin Décimo, review by Samuel Hym, Gabriel Scherer, Miod Vallat, 130 + B. Szilvasy, and Nicolás Ojeda Bär) 131 + 127 132 ### Code generation and optimizations: 128 133 129 134 ### Standard library:
-2
otherlibs/systhreads/st_pthreads.h
··· 45 45 return rc; 46 46 } 47 47 48 - #define ST_THREAD_FUNCTION void * 49 - 50 48 /* Thread termination */ 51 49 52 50 static void st_thread_join(st_thread_id thr)
+6 -34
otherlibs/systhreads/st_stubs.c
··· 14 14 /**************************************************************************/ 15 15 16 16 #define CAML_INTERNALS 17 - 18 - /* These macros must be defined before any winpthreads headers are included for 19 - any reason. In mingw-w64 13.0.0, a subtle change meant that time.h causes 20 - pthread_compat.h to be read. For this reason, this next block must appear 21 - before anything headers are included. */ 22 - #if defined(_WIN32) && !defined(NATIVE_CODE) && !defined(_MSC_VER) 23 - /* Ensure that pthread.h marks symbols __declspec(dllimport) so that they can be 24 - picked up from the runtime (which will have linked winpthreads statically). 25 - mingw-w64 11.0.0 introduced WINPTHREADS_USE_DLLIMPORT to do this explicitly; 26 - prior versions co-opted this on the internal DLL_EXPORT, but this is ignored 27 - in 11.0 and later unless IN_WINPTHREAD is also defined, so we can safely 28 - define both to support both versions. 29 - When compiling with MSVC, we currently link directly the winpthreads objects 30 - into our runtime, so we do not want to mark its symbols with 31 - __declspec(dllimport). */ 32 - #define WINPTHREADS_USE_DLLIMPORT 33 - #define DLL_EXPORT 34 - #endif 35 - 36 17 #define _GNU_SOURCE /* helps to find pthread_setname_np() */ 37 18 #include "caml/config.h" 38 19 39 20 #if defined(_WIN32) 40 21 # define WIN32_LEAN_AND_MEAN 41 22 # include <windows.h> 23 + # include <process.h> 42 24 # include <processthreadsapi.h> 43 25 # include "caml/osdeps.h" 44 26 ··· 713 695 /* Create a thread */ 714 696 715 697 /* the thread lock is not held when entering */ 716 - static void * caml_thread_start(void * v) 698 + static CAML_THREAD_FUNCTION 699 + caml_thread_start(void * v) 717 700 { 718 701 caml_thread_t th = (caml_thread_t) v; 719 702 int dom_id = th->domain_id; ··· 738 721 }; 739 722 740 723 /* The tick thread: interrupt the domain periodically to force preemption */ 741 - static void * caml_thread_tick(void * arg) 724 + static CAML_THREAD_FUNCTION caml_thread_tick(void * arg) 742 725 { 743 726 struct caml_thread_tick_args* tick_thread_args = 744 727 (struct caml_thread_tick_args*) arg; ··· 756 739 atomic_store_release(&domain->requested_external_interrupt, 1); 757 740 caml_interrupt_self(); 758 741 } 759 - return NULL; 742 + return 0; 760 743 } 761 744 762 745 static st_retcode create_tick_thread(void) ··· 1063 1046 /* Set the current thread's name. */ 1064 1047 CAMLprim value caml_set_current_thread_name(value name) 1065 1048 { 1066 - #if defined(_WIN32) 1067 - # if defined(HAS_SETTHREADDESCRIPTION) 1049 + #if defined(_WIN32) && defined(HAS_SETTHREADDESCRIPTION) 1068 1050 wchar_t *thread_name = caml_stat_strdup_to_utf16(String_val(name)); 1069 1051 HRESULT hr = SetThreadDescription(GetCurrentThread(), thread_name); 1070 1052 caml_stat_free(thread_name); 1071 1053 if (FAILED(hr)) 1072 1054 caml_set_current_thread_name_warning("SetThreadDescription failed!"); 1073 - # endif 1074 - 1075 - # if defined(HAVE_PTHREAD_SETNAME_NP) 1076 - // We are using both methods. 1077 - // See: https://github.com/ocaml/ocaml/pull/13504#discussion_r1786358928 1078 - char buf[1024]; 1079 - int ret = pthread_setname_np(pthread_self(), String_val(name)); 1080 - if (ret != 0) 1081 - caml_set_current_thread_name_warning(caml_strerror(ret, buf, sizeof(buf))); 1082 - # endif 1083 1055 1084 1056 #elif defined(HAS_PRCTL) 1085 1057 char buf[1024];
+74 -80
otherlibs/systhreads/st_win32.h
··· 30 30 Sleep(*timeout); 31 31 } 32 32 33 - /* POSIX thread implementation of the "st" interface */ 34 - 35 33 #include <errno.h> 36 34 #include <string.h> 37 35 #include <stdio.h> 38 36 #include <stdlib.h> 39 - #include <pthread.h> 40 37 #include <signal.h> 41 38 #include <time.h> 42 - #ifndef _WIN32 43 - #include <unistd.h> 44 - #endif 45 - 46 - 47 - typedef pthread_t st_thread_id; 39 + #include <caml/osdeps.h> 48 40 41 + typedef HANDLE st_thread_id; 49 42 50 43 /* Thread creation. Created in detached mode if [res] is NULL. */ 51 44 static int st_thread_create(st_thread_id * res, 52 - void * (*fn)(void *), void * arg) 45 + unsigned ( WINAPI *start_address )( void * ), 46 + void * arg) 53 47 { 54 - pthread_t thr; 55 - pthread_attr_t attr; 56 - int rc; 48 + st_thread_id thr; 49 + thr = (st_thread_id) _beginthreadex( 50 + NULL, /* security: handle can't be inherited */ 51 + 0, /* stack size */ 52 + start_address, 53 + arg, 54 + 0, /* run immediately */ 55 + NULL /* thread identifier */ 56 + ); 57 + if (thr == 0) 58 + return errno; 57 59 58 - pthread_attr_init(&attr); 59 - if (res == NULL) pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); 60 - rc = pthread_create(&thr, &attr, fn, arg); 61 - if (res != NULL) *res = thr; 62 - return rc; 60 + if (res == NULL) { 61 + /* detach */ 62 + if (!CloseHandle(thr)) { 63 + int err = caml_posixerr_of_win32err(GetLastError()); 64 + return err == 0 ? EINVAL : err; 65 + } 66 + } else { 67 + *res = thr; 68 + } 69 + return 0; 63 70 } 64 71 65 - #define ST_THREAD_FUNCTION void * 66 - 67 72 /* Thread termination */ 68 73 69 74 static void st_thread_join(st_thread_id thr) 70 75 { 71 - pthread_join(thr, NULL); 76 + WaitForSingleObject(thr, INFINITE); 72 77 /* best effort: ignore errors */ 73 78 } 74 79 75 80 /* Thread-specific state */ 76 81 77 - typedef pthread_key_t st_tlskey; 82 + typedef DWORD st_tlskey; 78 83 79 84 static int st_tls_newkey(st_tlskey * res) 80 85 { 81 - return pthread_key_create(res, NULL); 86 + DWORD index = TlsAlloc(); 87 + if (index == TLS_OUT_OF_INDEXES) { 88 + int err = caml_posixerr_of_win32err(GetLastError()); 89 + return err == 0 ? EINVAL : err; 90 + } 91 + *res = index; 92 + return 0; 82 93 } 83 94 84 95 Caml_inline void * st_tls_get(st_tlskey k) 85 96 { 86 - return pthread_getspecific(k); 97 + /* No errors are returned from pthread_getspecific(). Ignore 98 + * TlsGetValue() errors. */ 99 + return TlsGetValue(k); 87 100 } 88 101 89 102 Caml_inline void st_tls_set(st_tlskey k, void * v) 90 103 { 91 - pthread_setspecific(k, v); 104 + (void)TlsSetValue(k, v); 92 105 } 93 106 94 107 /* The master lock. This is a mutex that is held most of the time, ··· 99 112 typedef struct { 100 113 bool init; /* have the mutex and the cond been 101 114 initialized already? */ 102 - pthread_mutex_t lock; /* to protect contents */ 115 + SRWLOCK lock; /* to protect contents */ 103 116 bool busy; /* false = free, true = taken */ 104 117 atomic_uintnat waiters; /* number of threads waiting on master lock */ 105 - pthread_cond_t is_free; /* signaled when free */ 118 + CONDITION_VARIABLE is_free; /* signaled when free */ 106 119 } st_masterlock; 107 120 108 121 /* Returns non-zero on failure */ 109 122 static int st_masterlock_init(st_masterlock * m) 110 123 { 111 - int rc; 112 124 if (!m->init) { 113 - rc = pthread_mutex_init(&m->lock, NULL); 114 - if (rc != 0) goto out_err; 115 - rc = pthread_cond_init(&m->is_free, NULL); 116 - if (rc != 0) goto out_err2; 125 + InitializeSRWLock(&m->lock); 126 + InitializeConditionVariable(&m->is_free); 117 127 m->init = true; 118 128 } 119 129 m->busy = true; 120 130 atomic_store_release(&m->waiters, 0); 121 131 return 0; 122 - 123 - out_err2: 124 - pthread_mutex_destroy(&m->lock); 125 - out_err: 126 - return rc; 127 132 } 128 133 129 134 static void st_masterlock_destroy(st_masterlock * m) 130 135 { 131 - int rc; 132 - rc = pthread_cond_destroy(&m->is_free); 133 - CAMLassert(!rc); 134 - rc = pthread_mutex_destroy(&m->lock); 135 - CAMLassert(!rc); 136 - (void)rc; 136 + (void) m; 137 137 } 138 138 139 139 static uintnat st_masterlock_waiters(st_masterlock * m) ··· 143 143 144 144 static void st_masterlock_acquire(st_masterlock *m) 145 145 { 146 - pthread_mutex_lock(&m->lock); 146 + AcquireSRWLockExclusive(&m->lock); 147 147 while (m->busy) { 148 148 atomic_fetch_add(&m->waiters, +1); 149 - pthread_cond_wait(&m->is_free, &m->lock); 149 + SleepConditionVariableSRW(&m->is_free, &m->lock, 150 + INFINITE, 0 /* exclusive */); 150 151 atomic_fetch_add(&m->waiters, -1); 151 152 } 152 153 m->busy = true; 153 154 st_bt_lock_acquire(); 154 - pthread_mutex_unlock(&m->lock); 155 + ReleaseSRWLockExclusive(&m->lock); 155 156 156 157 return; 157 158 } 158 159 159 160 static void st_masterlock_release(st_masterlock * m) 160 161 { 161 - pthread_mutex_lock(&m->lock); 162 + AcquireSRWLockExclusive(&m->lock); 162 163 m->busy = false; 163 164 st_bt_lock_release(st_masterlock_waiters(m) == 0); 164 - pthread_cond_signal(&m->is_free); 165 - pthread_mutex_unlock(&m->lock); 165 + WakeConditionVariable(&m->is_free); 166 + ReleaseSRWLockExclusive(&m->lock); 166 167 167 168 return; 168 169 } ··· 178 179 */ 179 180 Caml_inline void st_thread_yield(st_masterlock * m) 180 181 { 181 - pthread_mutex_lock(&m->lock); 182 + AcquireSRWLockExclusive(&m->lock); 182 183 /* We must hold the lock to call this. */ 183 184 184 185 /* We already checked this without the lock, but we might have raced--if ··· 187 188 uintnat waiters = st_masterlock_waiters(m); 188 189 189 190 if (waiters == 0) { 190 - pthread_mutex_unlock(&m->lock); 191 + ReleaseSRWLockExclusive(&m->lock); 191 192 return; 192 193 } 193 194 194 195 m->busy = false; 195 196 atomic_fetch_add(&m->waiters, +1); 196 - pthread_cond_signal(&m->is_free); 197 + WakeConditionVariable(&m->is_free); 197 198 /* releasing the domain lock but not triggering bt messaging 198 199 messaging the bt should not be required because yield assumes 199 200 that a thread will resume execution (be it the yielding thread ··· 205 206 wait, which is good: we'll reliably continue waiting until the next 206 207 yield() or enter_blocking_section() call (or we see a spurious condvar 207 208 wakeup, which are rare at best.) */ 208 - pthread_cond_wait(&m->is_free, &m->lock); 209 + SleepConditionVariableSRW(&m->is_free, &m->lock, 210 + INFINITE, 0 /* exclusive */); 209 211 } while (m->busy); 210 212 211 213 m->busy = true; ··· 213 215 214 216 caml_acquire_domain_lock(); 215 217 216 - pthread_mutex_unlock(&m->lock); 218 + ReleaseSRWLockExclusive(&m->lock); 217 219 218 220 return; 219 221 } ··· 221 223 /* Triggered events */ 222 224 223 225 typedef struct st_event_struct { 224 - pthread_mutex_t lock; /* to protect contents */ 226 + SRWLOCK lock; /* to protect contents */ 225 227 bool status; /* false = not triggered, true = triggered */ 226 - pthread_cond_t triggered; /* signaled when triggered */ 228 + CONDITION_VARIABLE triggered; /* signaled when triggered */ 227 229 } * st_event; 228 230 229 231 230 232 static int st_event_create(st_event * res) 231 233 { 232 - int rc; 233 234 st_event e = caml_stat_alloc_noexc(sizeof(struct st_event_struct)); 234 235 if (e == NULL) return ENOMEM; 235 - rc = pthread_mutex_init(&e->lock, NULL); 236 - if (rc != 0) { caml_stat_free(e); return rc; } 237 - rc = pthread_cond_init(&e->triggered, NULL); 238 - if (rc != 0) 239 - { pthread_mutex_destroy(&e->lock); caml_stat_free(e); return rc; } 236 + InitializeSRWLock(&e->lock); 237 + InitializeConditionVariable(&e->triggered); 240 238 e->status = false; 241 239 *res = e; 242 240 return 0; ··· 244 242 245 243 static int st_event_destroy(st_event e) 246 244 { 247 - int rc1, rc2; 248 - rc1 = pthread_mutex_destroy(&e->lock); 249 - rc2 = pthread_cond_destroy(&e->triggered); 250 245 caml_stat_free(e); 251 - return rc1 != 0 ? rc1 : rc2; 246 + return 0; 252 247 } 253 248 254 249 static int st_event_trigger(st_event e) 255 250 { 256 - int rc; 257 - rc = pthread_mutex_lock(&e->lock); 258 - if (rc != 0) return rc; 251 + AcquireSRWLockExclusive(&e->lock); 259 252 e->status = true; 260 - rc = pthread_mutex_unlock(&e->lock); 261 - if (rc != 0) return rc; 262 - rc = pthread_cond_broadcast(&e->triggered); 263 - return rc; 253 + ReleaseSRWLockExclusive(&e->lock); 254 + WakeAllConditionVariable(&e->triggered); 255 + return 0; 264 256 } 265 257 266 258 static int st_event_wait(st_event e) 267 259 { 268 - int rc; 269 - rc = pthread_mutex_lock(&e->lock); 270 - if (rc != 0) return rc; 260 + AcquireSRWLockExclusive(&e->lock); 271 261 while(!e->status) { 272 - rc = pthread_cond_wait(&e->triggered, &e->lock); 273 - if (rc != 0) return rc; 262 + BOOL rc = SleepConditionVariableSRW(&e->triggered, &e->lock, 263 + INFINITE, 0 /* exclusive */); 264 + if (!rc) { 265 + int err = caml_posixerr_of_win32err(GetLastError()); 266 + return err == 0 ? EINVAL : err; 267 + } 274 268 } 275 - rc = pthread_mutex_unlock(&e->lock); 276 - return rc; 269 + ReleaseSRWLockExclusive(&e->lock); 270 + return 0; 277 271 }
-11
runtime/caml/io.h
··· 23 23 #include "camlatomic.h" 24 24 #include "misc.h" 25 25 #include "mlvalues.h" 26 - 27 - #ifndef _MSC_VER 28 26 #include "platform.h" 29 - #else 30 - /* We avoid including platform.h (which is really only necessary here to declare 31 - caml_plat_mutex) because that would end up pulling in pthread.h but we want 32 - to hide it on the MSVC port as it is not the native way to handle threads. 33 - So we inline here just the implementation of caml_plat_mutex on that port, 34 - this should be kept in sync */ 35 - #include <stdint.h> 36 - typedef intptr_t caml_plat_mutex; 37 - #endif 38 27 39 28 #if defined(_WIN32) 40 29 typedef int64_t file_offset;
+69 -22
runtime/caml/platform.h
··· 21 21 22 22 #ifdef CAML_INTERNALS 23 23 24 + #ifdef _WIN32 25 + #define WIN32_LEAN_AND_MEAN 26 + #define ATOM ATOM_WS 27 + #include <windows.h> 28 + #undef ATOM 29 + #include <process.h> 30 + #else 24 31 #include <pthread.h> 32 + #endif 33 + 25 34 #include <errno.h> 26 35 #include <string.h> 27 36 #include "config.h" 28 37 #include "mlvalues.h" 29 38 #include "sys.h" 39 + #include "osdeps.h" 30 40 #ifdef _MSC_VER 31 41 #include <intrin.h> 32 42 #endif ··· 103 113 104 114 #ifdef _WIN32 105 115 106 - typedef pthread_mutex_t caml_plat_mutex; 107 - #define CAML_PLAT_MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER 116 + typedef SRWLOCK caml_plat_mutex; 117 + #define CAML_PLAT_MUTEX_INITIALIZER SRWLOCK_INIT 108 118 109 - typedef pthread_cond_t caml_plat_cond; 110 - #define CAML_PLAT_COND_INITIALIZER PTHREAD_COND_INITIALIZER 119 + typedef CONDITION_VARIABLE caml_plat_cond; 120 + #define CAML_PLAT_COND_INITIALIZER CONDITION_VARIABLE_INIT 111 121 112 - typedef pthread_t caml_plat_thread; 113 - typedef pthread_attr_t caml_plat_thread_attr; 122 + typedef HANDLE caml_plat_thread; 123 + typedef void * caml_plat_thread_attr; 124 + 125 + #define CAML_THREAD_FUNCTION unsigned WINAPI 114 126 115 127 Caml_inline 116 128 int caml_plat_thread_create(caml_plat_thread *restrict thread, 117 129 const caml_plat_thread_attr *restrict attr, 118 - void *(*start_routine)(void *), 130 + unsigned ( WINAPI *start_address )( void * ), 119 131 void *restrict arg) 120 132 { 121 - return pthread_create(thread, attr, start_routine, arg); 133 + (void) attr; /* unused */ 134 + *thread = (caml_plat_thread) _beginthreadex( 135 + NULL, /* security: handle can't be inherited */ 136 + 0, /* stack size */ 137 + start_address, 138 + arg, 139 + 0, /* run immediately */ 140 + NULL /* thread identifier */ 141 + ); 142 + return (*thread != 0) ? 0 : errno; 122 143 } 123 144 124 145 Caml_inline 125 146 int caml_plat_thread_equal(caml_plat_thread t1, caml_plat_thread t2) 126 147 { 127 - return pthread_equal(t1, t2); 148 + DWORD id1 = GetThreadId(t1), id2 = GetThreadId(t2); 149 + return id1 == 0 || id2 == 0 ? -1 : id1 == id2; 128 150 } 129 151 130 152 Caml_inline 131 153 caml_plat_thread caml_plat_thread_self(void) 132 154 { 133 - return pthread_self(); 155 + /* A pseudo handle is a special constant that is interpreted as the 156 + * current thread handle. The function cannot be used by one thread 157 + * to create a handle that can be used by other threads to refer to 158 + * the first thread. The handle is always interpreted as referring 159 + * to the thread that is using it. */ 160 + return GetCurrentThread(); 134 161 } 135 162 136 163 Caml_inline 137 164 int caml_plat_thread_detach(caml_plat_thread thread) 138 165 { 139 - return pthread_detach(thread); 166 + /* This works as the thread handle is never duplicated. */ 167 + if (CloseHandle(thread)) { 168 + return 0; 169 + } else { 170 + int err = caml_posixerr_of_win32err(GetLastError()); 171 + return err == 0 ? EINVAL : err; 172 + } 140 173 } 141 174 142 175 Caml_inline 143 176 int caml_plat_thread_join(caml_plat_thread thread) 144 177 { 145 - return pthread_join(thread, NULL); 178 + DWORD rc = WaitForSingleObject(thread, INFINITE); 179 + switch (rc) { 180 + case WAIT_OBJECT_0: 181 + return 0; 182 + case WAIT_FAILED: { 183 + int err = caml_posixerr_of_win32err(GetLastError()); 184 + return err == 0 ? EINVAL : err; 185 + } 186 + default: 187 + CAMLunreachable(); 188 + } 146 189 } 147 190 148 191 Caml_inline 149 192 void caml_plat_thread_exit(void) 150 193 { 151 - pthread_exit(NULL); 194 + _endthreadex(0); 195 + /* The noreturn annotation is missing on _endthreadex, which per the 196 + * documentation ends with a call to ExitThread, itself noreturn. */ 197 + CAMLunreachable(); 152 198 } 153 199 154 200 Caml_inline 155 201 int caml_plat_thread_cancel(caml_plat_thread t) 156 202 { 157 - #ifdef HAVE_PTHREAD_CANCEL 158 - return pthread_cancel(t); 159 - #else 203 + if (!TerminateThread(t, 0)) { 204 + int err = caml_posixerr_of_win32err(GetLastError()); 205 + return err == 0 ? EINVAL : err; 206 + } 160 207 return 0; 161 - #endif 162 208 } 163 209 164 210 #else ··· 171 217 172 218 typedef pthread_t caml_plat_thread; 173 219 typedef pthread_attr_t caml_plat_thread_attr; 220 + 221 + #define CAML_THREAD_FUNCTION void * 174 222 175 223 Caml_inline 176 224 int caml_plat_thread_create(caml_plat_thread *restrict thread, ··· 574 622 575 623 Caml_inline void caml_plat_lock_blocking(caml_plat_mutex* m) 576 624 { 577 - check_err("lock", pthread_mutex_lock(m)); 625 + AcquireSRWLockExclusive(m); 578 626 DEBUG_LOCK(m); 579 627 } 580 628 581 629 Caml_inline int caml_plat_try_lock(caml_plat_mutex* m) 582 630 { 583 - int r = pthread_mutex_trylock(m); 584 - if (r == EBUSY) { 631 + BOOLEAN rc = TryAcquireSRWLockExclusive(m); 632 + if (!rc) { 585 633 return 0; 586 634 } else { 587 - check_err("try_lock", r); 588 635 DEBUG_LOCK(m); 589 636 return 1; 590 637 } ··· 593 640 Caml_inline void caml_plat_unlock(caml_plat_mutex* m) 594 641 { 595 642 DEBUG_UNLOCK(m); 596 - check_err("unlock", pthread_mutex_unlock(m)); 643 + ReleaseSRWLockExclusive(m); 597 644 } 598 645 599 646 #else
+8 -4
runtime/domain.c
··· 25 25 #ifndef _WIN32 26 26 #include <unistd.h> 27 27 #endif 28 - #include <pthread.h> 29 28 #include <string.h> 30 29 #include <assert.h> 31 30 #ifdef HAS_GNU_GETAFFINITY_NP ··· 43 42 #define WIN32_LEAN_AND_MEAN 44 43 #include <windows.h> 45 44 #include <sysinfoapi.h> 45 + #include <process.h> 46 + #else 47 + #include <pthread.h> 46 48 #endif 47 49 #include "caml/alloc.h" 48 50 #include "caml/backtrace.h" ··· 1157 1159 const char *error; /* out: set iff status is Dom_failed */ 1158 1160 }; 1159 1161 1160 - static void* backup_thread_func(void* v) 1162 + static CAML_THREAD_FUNCTION 1163 + backup_thread_func(void* v) 1161 1164 { 1162 1165 dom_internal* di = (dom_internal*)v; 1163 1166 uintnat msg; ··· 1384 1387 caml_plat_assert_all_locks_unlocked(); 1385 1388 } 1386 1389 1387 - static void* domain_thread_func(void* v) 1390 + static CAML_THREAD_FUNCTION 1391 + domain_thread_func(void* v) 1388 1392 { 1389 1393 struct domain_startup_params* p = v; 1390 1394 struct domain_ml_values *ml_values = p->ml_values; ··· 1447 1451 of it being destroyed by [caml_mutex_finalize] while it remains 1448 1452 locked, leading to undefined behaviour. */ 1449 1453 free_domain_ml_values(ml_values); 1450 - return NULL; 1454 + return 0; 1451 1455 } 1452 1456 1453 1457 /* Note: [caml_domain_spawn] and [caml_domain_alone()].
+1 -1
runtime/platform.c
··· 107 107 108 108 void caml_plat_futex_free(caml_plat_futex* ftx) { 109 109 caml_plat_mutex_free(&ftx->mutex); 110 - check_err("cond_destroy", pthread_cond_destroy(&ftx->cond)); 110 + caml_plat_cond_free(&ftx->cond); 111 111 } 112 112 113 113 #else /* ! CAML_PLAT_FUTEX_FALLBACK */
+31 -42
runtime/sync_win32.h
··· 3 3 /* OCaml */ 4 4 /* */ 5 5 /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ 6 + /* Antonin Decimo, Tarides */ 6 7 /* */ 7 8 /* Copyright 1996 Institut National de Recherche en Informatique et */ 8 9 /* en Automatique. */ 10 + /* Copyright 2025 Tarides */ 9 11 /* */ 10 12 /* All rights reserved. This file is distributed under the terms of */ 11 13 /* the GNU Lesser General Public License version 2.1, with the */ ··· 13 15 /* */ 14 16 /**************************************************************************/ 15 17 16 - /* POSIX thread implementation of the user facing Mutex and Condition */ 18 + /* Windows implementation of the user facing Mutex and Condition */ 17 19 /* To be included in runtime/sync.c */ 18 20 19 - #ifndef CAML_SYNC_POSIX_H 20 - #define CAML_SYNC_POSIX_H 21 + #ifndef CAML_SYNC_WIN32_H 22 + #define CAML_SYNC_WIN32_H 21 23 22 - #include <errno.h> 23 - #include <pthread.h> 24 - #include <string.h> 24 + #define WIN32_LEAN_AND_MEAN 25 + #include <windows.h> 25 26 26 27 #include "caml/sync.h" 28 + #include "caml/osdeps.h" 27 29 28 30 typedef int sync_retcode; 29 31 ··· 31 33 32 34 Caml_inline int sync_mutex_create(sync_mutex * res) 33 35 { 34 - int rc; 35 - pthread_mutexattr_t attr; 36 - sync_mutex m; 37 - 38 - rc = pthread_mutexattr_init(&attr); 39 - if (rc != 0) goto error1; 40 - rc = pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_ERRORCHECK); 41 - if (rc != 0) goto error2; 42 - m = caml_stat_alloc_noexc(sizeof(pthread_mutex_t)); 43 - if (m == NULL) { rc = ENOMEM; goto error2; } 44 - rc = pthread_mutex_init(m, &attr); 45 - if (rc != 0) goto error3; 46 - pthread_mutexattr_destroy(&attr); 36 + sync_mutex m = caml_stat_alloc_noexc(sizeof(SRWLOCK)); 37 + if (m == NULL) return ENOMEM; 38 + InitializeSRWLock(m); 47 39 *res = m; 48 40 return 0; 49 - error3: 50 - caml_stat_free(m); 51 - error2: 52 - pthread_mutexattr_destroy(&attr); 53 - error1: 54 - return rc; 55 41 } 56 42 57 43 Caml_inline int sync_mutex_destroy(sync_mutex m) 58 44 { 59 - int rc; 60 - rc = pthread_mutex_destroy(m); 61 45 caml_stat_free(m); 62 - return rc; 46 + return 0; 63 47 } 64 48 65 49 Caml_inline int sync_mutex_lock(sync_mutex m) 66 50 { 67 - return pthread_mutex_lock(m); 51 + AcquireSRWLockExclusive(m); 52 + return 0; 68 53 } 69 54 70 55 #define MUTEX_PREVIOUSLY_UNLOCKED 0 ··· 72 57 73 58 Caml_inline int sync_mutex_trylock(sync_mutex m) 74 59 { 75 - return pthread_mutex_trylock(m); 60 + return TryAcquireSRWLockExclusive(m) ? 61 + MUTEX_PREVIOUSLY_UNLOCKED : MUTEX_ALREADY_LOCKED; 76 62 } 77 63 78 64 Caml_inline int sync_mutex_unlock(sync_mutex m) 79 65 { 80 - return pthread_mutex_unlock(m); 66 + ReleaseSRWLockExclusive(m); 67 + return 0; 81 68 } 82 69 83 70 /* Condition variables */ 84 71 85 72 Caml_inline int sync_condvar_create(sync_condvar * res) 86 73 { 87 - int rc; 88 - sync_condvar c = caml_stat_alloc_noexc(sizeof(pthread_cond_t)); 74 + sync_condvar c = caml_stat_alloc_noexc(sizeof(CONDITION_VARIABLE)); 89 75 if (c == NULL) return ENOMEM; 90 - rc = pthread_cond_init(c, NULL); 91 - if (rc != 0) { caml_stat_free(c); return rc; } 76 + InitializeConditionVariable(c); 92 77 *res = c; 93 78 return 0; 94 79 } 95 80 96 81 Caml_inline int sync_condvar_destroy(sync_condvar c) 97 82 { 98 - int rc; 99 - rc = pthread_cond_destroy(c); 100 83 caml_stat_free(c); 101 - return rc; 84 + return 0; 102 85 } 103 86 104 87 Caml_inline int sync_condvar_signal(sync_condvar c) 105 88 { 106 - return pthread_cond_signal(c); 89 + WakeConditionVariable(c); 90 + return 0; 107 91 } 108 92 109 93 Caml_inline int sync_condvar_broadcast(sync_condvar c) 110 94 { 111 - return pthread_cond_broadcast(c); 95 + WakeAllConditionVariable(c); 96 + return 0; 112 97 } 113 98 114 99 Caml_inline int sync_condvar_wait(sync_condvar c, sync_mutex m) 115 100 { 116 - return pthread_cond_wait(c, m); 101 + if (!SleepConditionVariableSRW(c, m, INFINITE, 0 /* exclusive */)) { 102 + int rc = caml_posixerr_of_win32err(GetLastError()); 103 + return rc == 0 ? EINVAL : rc; 104 + } 105 + return 0; 117 106 } 118 107 119 - #endif /* CAML_SYNC_POSIX_H */ 108 + #endif /* CAML_SYNC_WIN32_H */
+17 -40
runtime/win32.c
··· 23 23 24 24 #define WIN32_LEAN_AND_MEAN 25 25 #define _CRT_RAND_S 26 + #include <windows.h> 26 27 #include <wtypes.h> 27 28 #include <winbase.h> 28 29 #include <winsock2.h> ··· 30 31 #include <shlobj.h> 31 32 #include <shlwapi.h> 32 33 #include <direct.h> 34 + #include <process.h> 33 35 #include <stdlib.h> 34 36 #include <stdio.h> 35 37 #include <stdarg.h> ··· 1433 1435 1434 1436 CAMLexport void caml_plat_mutex_init(caml_plat_mutex * m) 1435 1437 { 1436 - int rc; 1437 - pthread_mutexattr_t attr; 1438 - rc = pthread_mutexattr_init(&attr); 1439 - if (rc != 0) goto error1; 1440 - rc = pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_ERRORCHECK); 1441 - if (rc != 0) goto error2; 1442 - rc = pthread_mutex_init(m, &attr); 1443 - // fall through 1444 - error2: 1445 - pthread_mutexattr_destroy(&attr); 1446 - error1: 1447 - check_err("mutex_init", rc); 1438 + InitializeSRWLock(m); 1448 1439 } 1449 1440 1450 - void caml_plat_assert_locked(caml_plat_mutex* m) 1441 + void caml_plat_assert_locked(caml_plat_mutex *m) 1451 1442 { 1452 1443 #ifdef DEBUG 1453 - int r = pthread_mutex_trylock(m); 1454 - if (r == EBUSY) { 1444 + BOOLEAN r = TryAcquireSRWLockExclusive(m); 1445 + if (r == 0) { 1455 1446 /* ok, it was locked */ 1456 1447 return; 1457 - } else if (r == 0) { 1458 - caml_fatal_error("Required mutex not locked"); 1459 1448 } else { 1460 - check_err("assert_locked", r); 1449 + caml_fatal_error("Required mutex not locked"); 1461 1450 } 1462 1451 #endif 1463 1452 } ··· 1466 1455 { 1467 1456 /* Avoid exceptions */ 1468 1457 caml_enter_blocking_section_no_pending(); 1469 - int rc = pthread_mutex_lock(m); 1458 + AcquireSRWLockExclusive(m); 1470 1459 caml_leave_blocking_section(); 1471 - check_err("lock_non_blocking", rc); 1472 1460 DEBUG_LOCK(m); 1473 1461 } 1474 1462 1475 1463 void caml_plat_mutex_free(caml_plat_mutex* m) 1476 1464 { 1477 - check_err("mutex_free", pthread_mutex_destroy(m)); 1465 + /* nothing to do */ 1478 1466 } 1479 1467 1480 1468 /* Condition variables */ 1481 1469 1482 - static void caml_plat_cond_init_aux(caml_plat_cond *cond) 1470 + void caml_plat_cond_init(caml_plat_cond *cond) 1483 1471 { 1484 - pthread_condattr_t attr; 1485 - pthread_condattr_init(&attr); 1486 - #if defined(_POSIX_TIMERS) && \ 1487 - defined(_POSIX_MONOTONIC_CLOCK) && \ 1488 - _POSIX_MONOTONIC_CLOCK != (-1) 1489 - pthread_condattr_setclock(&attr, CLOCK_MONOTONIC); 1490 - #endif 1491 - pthread_cond_init(cond, &attr); 1472 + InitializeConditionVariable(cond); 1492 1473 } 1493 1474 1494 - void caml_plat_cond_init(caml_plat_cond* cond) 1495 - { 1496 - caml_plat_cond_init_aux(cond); 1497 - } 1498 - 1499 - void caml_plat_wait(caml_plat_cond* cond, caml_plat_mutex* mut) 1475 + void caml_plat_wait(caml_plat_cond *cond, caml_plat_mutex* mut) 1500 1476 { 1501 1477 caml_plat_assert_locked(mut); 1502 - check_err("wait", pthread_cond_wait(cond, mut)); 1478 + BOOL rc = SleepConditionVariableSRW(cond, mut, INFINITE, 0 /* exclusive */); 1479 + check_err("wait", rc == 0); 1503 1480 } 1504 1481 1505 1482 void caml_plat_broadcast(caml_plat_cond* cond) 1506 1483 { 1507 - check_err("cond_broadcast", pthread_cond_broadcast(cond)); 1484 + WakeAllConditionVariable(cond); 1508 1485 } 1509 1486 1510 1487 void caml_plat_signal(caml_plat_cond* cond) 1511 1488 { 1512 - check_err("cond_signal", pthread_cond_signal(cond)); 1489 + WakeConditionVariable(cond); 1513 1490 } 1514 1491 1515 1492 void caml_plat_cond_free(caml_plat_cond* cond) 1516 1493 { 1517 - check_err("cond_free", pthread_cond_destroy(cond)); 1494 + /* nothing to do */ 1518 1495 }
+14 -5
stdlib/mutex.mli
··· 38 38 by another thread will suspend until the other thread unlocks 39 39 the mutex. 40 40 41 - @raise Sys_error if the mutex is already locked by the thread calling 42 - {!Mutex.lock}. 41 + @raise Sys_error if the mutex is already locked by the thread 42 + calling {!Mutex.lock} on Unix platforms. On Windows, recursive 43 + locking deadlocks. 43 44 44 45 @before 4.12 {!Sys_error} was not raised for recursive locking 45 - (platform-dependent behaviour) *) 46 + (platform-dependent behaviour). 47 + 48 + @since 5.3 On Windows, {!Sys_error} is not raised for recursive 49 + locking. *) 46 50 47 51 val try_lock : t -> bool 48 52 (** Same as {!Mutex.lock}, but does not suspend the calling thread if ··· 54 58 (** Unlock the given mutex. Other threads suspended trying to lock 55 59 the mutex will restart. The mutex must have been previously locked 56 60 by the thread that calls {!Mutex.unlock}. 57 - @raise Sys_error if the mutex is unlocked or was locked by another thread. 61 + 62 + @raise Sys_error if the mutex is unlocked or was locked by another 63 + thread. This doesn't apply on Windows since OCaml 5.3. 58 64 59 65 @before 4.12 {!Sys_error} was not raised when unlocking an unlocked mutex 60 - or when unlocking a mutex from a different thread. *) 66 + or when unlocking a mutex from a different thread. 67 + 68 + @since 5.3 On Windows, {!Sys_error} is not raised if the mutex is 69 + unlocked or was locked by another thread. *) 61 70 62 71 val protect : t -> (unit -> 'a) -> 'a 63 72 (** [protect mutex f] runs [f()] in a critical section where [mutex]
+13 -4
testsuite/tests/lib-systhreads/test_c_thread_register_cstubs.c
··· 1 1 #include <string.h> 2 2 #ifdef _WIN32 3 3 #include <windows.h> 4 - #define THREAD_FUNCTION DWORD WINAPI 4 + #include <process.h> 5 5 #else 6 6 #include <pthread.h> 7 - #define THREAD_FUNCTION void * 8 7 #endif 8 + #define CAML_INTERNALS 9 9 #include <caml/mlvalues.h> 10 10 #include <caml/gc.h> 11 11 #include <caml/memory.h> 12 12 #include <caml/callback.h> 13 + #include <caml/platform.h> 13 14 #include <caml/threads.h> 14 15 15 - THREAD_FUNCTION thread_func(void *fn) { 16 + static CAML_THREAD_FUNCTION thread_func(void *fn) { 16 17 caml_c_thread_register(); 17 18 caml_acquire_runtime_system(); 18 19 caml_callback((value) fn, Val_unit); ··· 24 25 value spawn_thread(value clos) 25 26 { 26 27 #ifdef _WIN32 27 - CloseHandle(CreateThread(NULL, 0, &thread_func, (void *) clos, 0, NULL)); 28 + HANDLE thread = (HANDLE) _beginthreadex( 29 + NULL, /* security: handle can't be inherited */ 30 + 0, /* stack size */ 31 + &thread_func, 32 + (void *) clos, 33 + 0, /* run immediately */ 34 + NULL /* thread identifier */ 35 + ); 36 + CloseHandle(thread); /* detach */ 28 37 #else 29 38 pthread_t thr; 30 39 pthread_attr_t attr;
+1
testsuite/tests/lib-threads/mutex_errors.ml
··· 2 2 include systhreads; 3 3 hassysthreads; 4 4 no-tsan; (* tsan detects the mutex errors and fails *) 5 + not-windows; (* Windows' SRWLock differ from pthreads ERRORCHECK mutexes. *) 5 6 { 6 7 bytecode; 7 8 }{
+14 -5
testsuite/tests/parallel/test_c_thread_register_cstubs.c
··· 2 2 #include <stdbool.h> 3 3 #ifdef _WIN32 4 4 #include <windows.h> 5 - #define THREAD_FUNCTION DWORD WINAPI 5 + #include <process.h> 6 6 #else 7 7 #include <pthread.h> 8 - #define THREAD_FUNCTION void * 9 8 #endif 9 + #define CAML_INTERNALS 10 10 #include <caml/config.h> 11 11 #include <caml/mlvalues.h> 12 12 #include <caml/gc.h> 13 13 #include <caml/memory.h> 14 14 #include <caml/callback.h> 15 + #include <caml/platform.h> 15 16 #include <caml/threads.h> 16 17 17 18 typedef struct { ··· 21 22 } thread_args; 22 23 23 24 // Note: We never release this, to keep the test code simple. 24 - void *create_root(value v) 25 + static void *create_root(value v) 25 26 { 26 27 value *root = malloc(sizeof(value)); 27 28 *root = v; ··· 35 36 return *root; 36 37 } 37 38 38 - THREAD_FUNCTION thread_func(void *arg) 39 + static CAML_THREAD_FUNCTION thread_func(void *arg) 39 40 { 40 41 thread_args *args = (thread_args*)arg; 41 42 ··· 76 77 args->second_domain_unique_id = second_domain_unique_id; 77 78 args->root = root; 78 79 #if _WIN32 79 - CloseHandle(CreateThread(NULL, 0, &thread_func, args, 0, NULL)); 80 + HANDLE thread = (HANDLE) _beginthreadex( 81 + NULL, /* security: handle can't be inherited */ 82 + 0, /* stack size */ 83 + &thread_func, 84 + args, 85 + 0, /* run immediately */ 86 + NULL /* thread identifier */ 87 + ); 88 + CloseHandle(thread); /* detach */ 80 89 #else 81 90 pthread_t thr; 82 91 pthread_attr_t attr;
+1 -14
testsuite/tools/testToplevel.ml
··· 42 42 if Sys.file_exists threads_plugin then 43 43 Harness.fail_because 44 44 "threads.cmxs is not expected to exist" 45 - else if Sys.win32 then 46 - (* cf. note in ocaml/ocaml#13520 - threads.cmxa is 47 - correctly compiled assuming winpthreads is statically 48 - in the same image (so without defining 49 - WINPTHREADS_USE_DLLIMPORT), but this is incorrect for 50 - threads.cmxs, as threads.cmxs may load more than 2GiB 51 - away from the main executable. For native Windows, it's 52 - not possible to rely on ocamlnat's automatic 53 - cmxa -> cmxs recompilation. *) 54 - "cmxs" 55 45 else 56 46 (* cf. ocaml/ocaml#12250 - no threads.cmxs *) 57 47 "cmxa" ··· 78 68 (* Systems configured with --disable-shared can't load bytecode libraries 79 69 which need C stubs *) 80 70 if Sys.cygwin && mode = Native && List.mem "unix" libraries 81 - || Sys.win32 && mode = Native && List.mem "threads" libraries 82 71 || has_c_stubs && not Config.supports_shared_libraries then 83 - (* cf. ocaml/flexdll#146 - Cygwin's ocamlnat can't load unix.cmxs and 84 - the lines above will have triggered native Windows being unable to 85 - load threads.cmxs *) 72 + (* cf. ocaml/flexdll#146 - Cygwin's ocamlnat can't load unix.cmxs *) 86 73 125 87 74 else 88 75 0