anil.recoil.org
My working unpac repository
Implement errorcheck mutexes on Windows
+26
-9
runtime/caml/platform.h
+26
-9
runtime/caml/platform.h
···
113
114
#ifdef _WIN32
115
116
-
typedef SRWLOCK caml_plat_mutex;
117
-
#define CAML_PLAT_MUTEX_INITIALIZER SRWLOCK_INIT
118
119
typedef CONDITION_VARIABLE caml_plat_cond;
120
#define CAML_PLAT_COND_INITIALIZER CONDITION_VARIABLE_INIT
···
622
623
Caml_inline void caml_plat_lock_blocking(caml_plat_mutex* m)
624
{
625
-
AcquireSRWLockExclusive(m);
626
-
DEBUG_LOCK(m);
627
}
628
629
Caml_inline int caml_plat_try_lock(caml_plat_mutex* m)
630
{
631
-
BOOLEAN rc = TryAcquireSRWLockExclusive(m);
632
-
if (!rc) {
633
-
return 0;
634
-
} else {
635
DEBUG_LOCK(m);
636
return 1;
637
}
638
}
639
640
Caml_inline void caml_plat_unlock(caml_plat_mutex* m)
641
{
642
DEBUG_UNLOCK(m);
643
-
ReleaseSRWLockExclusive(m);
644
}
645
646
#else
···
113
114
#ifdef _WIN32
115
116
+
typedef struct {
117
+
SRWLOCK lock;
118
+
_Atomic DWORD owner_tid; /* 0 if not owned */
119
+
/* The "owner_tid" field is not always protected by "lock"; it is
120
+
* also accessed without holding "lock". */
121
+
} caml_plat_mutex;
122
+
#define CAML_PLAT_MUTEX_INITIALIZER { SRWLOCK_INIT, 0 }
123
124
typedef CONDITION_VARIABLE caml_plat_cond;
125
#define CAML_PLAT_COND_INITIALIZER CONDITION_VARIABLE_INIT
···
627
628
Caml_inline void caml_plat_lock_blocking(caml_plat_mutex* m)
629
{
630
+
DWORD self_tid = GetCurrentThreadId();
631
+
if (m->owner_tid != self_tid) {
632
+
AcquireSRWLockExclusive(&m->lock);
633
+
m->owner_tid = self_tid;
634
+
DEBUG_LOCK(m);
635
+
} else {
636
+
check_err("lock", EDEADLK);
637
+
}
638
}
639
640
Caml_inline int caml_plat_try_lock(caml_plat_mutex* m)
641
{
642
+
if (TryAcquireSRWLockExclusive(&m->lock)) {
643
+
m->owner_tid = GetCurrentThreadId();
644
DEBUG_LOCK(m);
645
return 1;
646
+
} else {
647
+
return 0;
648
}
649
}
650
651
Caml_inline void caml_plat_unlock(caml_plat_mutex* m)
652
{
653
+
DWORD self_tid = GetCurrentThreadId();
654
DEBUG_UNLOCK(m);
655
+
if (m->owner_tid == self_tid) {
656
+
m->owner_tid = 0;
657
+
ReleaseSRWLockExclusive(&m->lock);
658
+
} else {
659
+
check_err("unlock", EPERM);
660
+
}
661
}
662
663
#else
+40
-12
runtime/sync_win32.h
+40
-12
runtime/sync_win32.h
···
33
34
Caml_inline int sync_mutex_create(sync_mutex * res)
35
{
36
-
sync_mutex m = caml_stat_alloc_noexc(sizeof(SRWLOCK));
37
if (m == NULL) return ENOMEM;
38
-
InitializeSRWLock(m);
39
*res = m;
40
return 0;
41
}
···
48
49
Caml_inline int sync_mutex_lock(sync_mutex m)
50
{
51
-
AcquireSRWLockExclusive(m);
52
-
return 0;
53
}
54
55
#define MUTEX_PREVIOUSLY_UNLOCKED 0
···
57
58
Caml_inline int sync_mutex_trylock(sync_mutex m)
59
{
60
-
return TryAcquireSRWLockExclusive(m) ?
61
-
MUTEX_PREVIOUSLY_UNLOCKED : MUTEX_ALREADY_LOCKED;
62
}
63
64
Caml_inline int sync_mutex_unlock(sync_mutex m)
65
{
66
-
ReleaseSRWLockExclusive(m);
67
-
return 0;
68
}
69
70
/* Condition variables */
···
98
99
Caml_inline int sync_condvar_wait(sync_condvar c, sync_mutex m)
100
{
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;
106
}
107
108
#endif /* CAML_SYNC_WIN32_H */
···
33
34
Caml_inline int sync_mutex_create(sync_mutex * res)
35
{
36
+
sync_mutex m = caml_stat_alloc_noexc(sizeof(caml_plat_mutex));
37
if (m == NULL) return ENOMEM;
38
+
InitializeSRWLock(&m->lock);
39
+
m->owner_tid = 0;
40
*res = m;
41
return 0;
42
}
···
49
50
Caml_inline int sync_mutex_lock(sync_mutex m)
51
{
52
+
DWORD self_tid = GetCurrentThreadId();
53
+
if (m->owner_tid != self_tid) {
54
+
AcquireSRWLockExclusive(&m->lock);
55
+
m->owner_tid = self_tid;
56
+
return 0;
57
+
} else {
58
+
return EDEADLK;
59
+
}
60
}
61
62
#define MUTEX_PREVIOUSLY_UNLOCKED 0
···
64
65
Caml_inline int sync_mutex_trylock(sync_mutex m)
66
{
67
+
if (TryAcquireSRWLockExclusive(&m->lock)) {
68
+
m->owner_tid = GetCurrentThreadId();
69
+
return MUTEX_PREVIOUSLY_UNLOCKED;
70
+
} else {
71
+
return MUTEX_ALREADY_LOCKED;
72
+
}
73
}
74
75
Caml_inline int sync_mutex_unlock(sync_mutex m)
76
{
77
+
DWORD self_tid = GetCurrentThreadId();
78
+
if (m->owner_tid == self_tid) {
79
+
m->owner_tid = 0;
80
+
ReleaseSRWLockExclusive(&m->lock);
81
+
return 0;
82
+
} else {
83
+
return EPERM;
84
+
}
85
}
86
87
/* Condition variables */
···
115
116
Caml_inline int sync_condvar_wait(sync_condvar c, sync_mutex m)
117
{
118
+
DWORD self_tid = GetCurrentThreadId();
119
+
int rc = 0;
120
+
if (m->owner_tid == self_tid) {
121
+
m->owner_tid = 0;
122
+
if (SleepConditionVariableSRW(c, &m->lock, INFINITE,
123
+
0 /* exclusive */)) {
124
+
m->owner_tid = self_tid;
125
+
} else {
126
+
rc = caml_posixerr_of_win32err(GetLastError());
127
+
/* Not clear if the thread owns the mutex or not, but there's a
128
+
* fatal error anyway. */
129
+
}
130
+
} else {
131
+
rc = EPERM;
132
}
133
+
return rc;
134
}
135
136
#endif /* CAML_SYNC_WIN32_H */
+26
-5
runtime/win32.c
+26
-5
runtime/win32.c
···
1435
1436
CAMLexport void caml_plat_mutex_init(caml_plat_mutex * m)
1437
{
1438
-
InitializeSRWLock(m);
1439
}
1440
1441
void caml_plat_assert_locked(caml_plat_mutex *m)
1442
{
1443
#ifdef DEBUG
1444
-
BOOLEAN r = TryAcquireSRWLockExclusive(m);
1445
if (r == 0) {
1446
/* ok, it was locked */
1447
return;
···
1455
{
1456
/* Avoid exceptions */
1457
caml_enter_blocking_section_no_pending();
1458
-
AcquireSRWLockExclusive(m);
1459
caml_leave_blocking_section();
1460
DEBUG_LOCK(m);
1461
}
···
1475
void caml_plat_wait(caml_plat_cond *cond, caml_plat_mutex* mut)
1476
{
1477
caml_plat_assert_locked(mut);
1478
-
BOOL rc = SleepConditionVariableSRW(cond, mut, INFINITE, 0 /* exclusive */);
1479
-
check_err("wait", rc == 0);
1480
}
1481
1482
void caml_plat_broadcast(caml_plat_cond* cond)
···
1435
1436
CAMLexport void caml_plat_mutex_init(caml_plat_mutex * m)
1437
{
1438
+
InitializeSRWLock(&m->lock);
1439
+
m->owner_tid = 0;
1440
}
1441
1442
void caml_plat_assert_locked(caml_plat_mutex *m)
1443
{
1444
#ifdef DEBUG
1445
+
BOOLEAN r = TryAcquireSRWLockExclusive(&m->lock);
1446
if (r == 0) {
1447
/* ok, it was locked */
1448
return;
···
1456
{
1457
/* Avoid exceptions */
1458
caml_enter_blocking_section_no_pending();
1459
+
DWORD self_tid = GetCurrentThreadId();
1460
+
if (m->owner_tid != self_tid) {
1461
+
AcquireSRWLockExclusive(&m->lock);
1462
+
m->owner_tid = self_tid;
1463
+
} else {
1464
+
check_err("lock_non_blocking", EDEADLK);
1465
+
}
1466
caml_leave_blocking_section();
1467
DEBUG_LOCK(m);
1468
}
···
1482
void caml_plat_wait(caml_plat_cond *cond, caml_plat_mutex* mut)
1483
{
1484
caml_plat_assert_locked(mut);
1485
+
DWORD self_tid = GetCurrentThreadId();
1486
+
int rc = 0;
1487
+
if (mut->owner_tid == self_tid) {
1488
+
mut->owner_tid = 0;
1489
+
if (SleepConditionVariableSRW(cond, &mut->lock, INFINITE,
1490
+
0 /* exclusive */)) {
1491
+
mut->owner_tid = self_tid;
1492
+
} else {
1493
+
rc = caml_posixerr_of_win32err(GetLastError());
1494
+
/* Not clear if the thread owns the mutex or not, but there's a
1495
+
* fatal error anyway. */
1496
+
}
1497
+
} else {
1498
+
rc = EPERM;
1499
+
}
1500
+
check_err("wait", rc);
1501
}
1502
1503
void caml_plat_broadcast(caml_plat_cond* cond)
+5
-14
stdlib/mutex.mli
+5
-14
stdlib/mutex.mli
···
38
by another thread will suspend until the other thread unlocks
39
the mutex.
40
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.
44
45
@before 4.12 {!Sys_error} was not raised for recursive locking
46
-
(platform-dependent behaviour).
47
-
48
-
@since 5.3 On Windows, {!Sys_error} is not raised for recursive
49
-
locking. *)
50
51
val try_lock : t -> bool
52
(** Same as {!Mutex.lock}, but does not suspend the calling thread if
···
58
(** Unlock the given mutex. Other threads suspended trying to lock
59
the mutex will restart. The mutex must have been previously locked
60
by the thread that calls {!Mutex.unlock}.
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.
64
65
@before 4.12 {!Sys_error} was not raised when unlocking an unlocked mutex
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. *)
70
71
val protect : t -> (unit -> 'a) -> 'a
72
(** [protect mutex f] runs [f()] in a critical section where [mutex]
···
38
by another thread will suspend until the other thread unlocks
39
the mutex.
40
41
+
@raise Sys_error if the mutex is already locked by the thread calling
42
+
{!Mutex.lock}.
43
44
@before 4.12 {!Sys_error} was not raised for recursive locking
45
+
(platform-dependent behaviour) *)
46
47
val try_lock : t -> bool
48
(** Same as {!Mutex.lock}, but does not suspend the calling thread if
···
54
(** Unlock the given mutex. Other threads suspended trying to lock
55
the mutex will restart. The mutex must have been previously locked
56
by the thread that calls {!Mutex.unlock}.
57
+
@raise Sys_error if the mutex is unlocked or was locked by another thread.
58
59
@before 4.12 {!Sys_error} was not raised when unlocking an unlocked mutex
60
+
or when unlocking a mutex from a different thread. *)
61
62
val protect : t -> (unit -> 'a) -> 'a
63
(** [protect mutex f] runs [f()] in a critical section where [mutex]
-1
testsuite/tests/lib-threads/mutex_errors.ml
-1
testsuite/tests/lib-threads/mutex_errors.ml