CAMLprim value caml_mutex_new(value unit) { value mut; mut = alloc_custom(&caml_mutex_ops, sizeof(HANDLE), 1, Max_mutex_number); Mutex_val(mut) = CreateMutex(0, FALSE, NULL); if (Mutex_val(mut) == NULL) caml_wthread_error("Mutex.create"); return mut; }
CAMLprim value caml_mutex_lock(value mut) { int retcode; /* PR#4351: first try to acquire mutex without releasing the master lock */ retcode = WaitForSingleObject(Mutex_val(mut), 0); if (retcode == WAIT_OBJECT_0) return Val_unit; Begin_root(mut) /* prevent deallocation of mutex */ enter_blocking_section(); retcode = WaitForSingleObject(Mutex_val(mut), INFINITE); leave_blocking_section(); End_roots(); if (retcode == WAIT_FAILED) caml_wthread_error("Mutex.lock"); return Val_unit; }
CAMLprim value caml_mutex_try_lock(value mut) { int retcode; retcode = WaitForSingleObject(Mutex_val(mut), 0); if (retcode == WAIT_FAILED || retcode == WAIT_ABANDONED) caml_wthread_error("Mutex.try_lock"); return Val_bool(retcode == WAIT_OBJECT_0); }
CAMLprim value caml_mutex_unlock(value mut) { BOOL retcode; /* PR#4351: no need to release and reacquire master lock */ retcode = ReleaseMutex(Mutex_val(mut)); if (!retcode) caml_wthread_error("Mutex.unlock"); return Val_unit; }
CAMLprim value caml_mutex_try_lock(value wrapper) /* ML */ { st_mutex mut = Mutex_val(wrapper); st_retcode retcode; retcode = st_mutex_trylock(mut); if (retcode == ALREADY_LOCKED) return Val_false; st_check_error(retcode, "Mutex.try_lock"); return Val_true; }
CAMLprim value caml_mutex_unlock(value wrapper) /* ML */ { st_mutex mut = Mutex_val(wrapper); st_retcode retcode; /* PR#4351: no need to release and reacquire master lock */ retcode = st_mutex_unlock(mut); st_check_error(retcode, "Mutex.unlock"); return Val_unit; }
CAMLprim value caml_mutex_new(value unit) /* ML */ { st_mutex mut = NULL; /* suppress warning */ value wrapper; st_check_error(st_mutex_create(&mut), "Mutex.create"); wrapper = alloc_custom(&caml_mutex_ops, sizeof(st_mutex *), 1, Max_mutex_number); Mutex_val(wrapper) = mut; return wrapper; }
CAMLprim value caml_mutex_unlock(value mut) { BOOL retcode; Begin_root(mut) /* prevent deallocation of mutex */ enter_blocking_section(); retcode = ReleaseMutex(Mutex_val(mut)); leave_blocking_section(); End_roots(); if (!retcode) caml_wthread_error("Mutex.unlock"); return Val_unit; }
CAMLprim value caml_mutex_lock(value mut) { int retcode; Begin_root(mut) /* prevent deallocation of mutex */ enter_blocking_section(); retcode = WaitForSingleObject(Mutex_val(mut), INFINITE); leave_blocking_section(); End_roots(); if (retcode == WAIT_FAILED) caml_wthread_error("Mutex.lock"); return Val_unit; }
CAMLprim value caml_condition_wait(value wcond, value wmut) /* ML */ { st_condvar cond = Condition_val(wcond); st_mutex mut = Mutex_val(wmut); st_retcode retcode; Begin_roots2(wcond, wmut) /* prevent deallocation of cond and mutex */ enter_blocking_section(); retcode = st_condvar_wait(cond, mut); leave_blocking_section(); End_roots(); st_check_error(retcode, "Condition.wait"); return Val_unit; }
CAMLprim value caml_mutex_lock(value wrapper) /* ML */ { st_mutex mut = Mutex_val(wrapper); st_retcode retcode; /* PR#4351: first try to acquire mutex without releasing the master lock */ if (st_mutex_trylock(mut) == PREVIOUSLY_UNLOCKED) return Val_unit; /* If unsuccessful, block on mutex */ Begin_root(wrapper) /* prevent the deallocation of mutex */ enter_blocking_section(); retcode = st_mutex_lock(mut); leave_blocking_section(); End_roots(); st_check_error(retcode, "Mutex.lock"); return Val_unit; }
CAMLprim value caml_condition_wait(value cond, value mut) { int retcode; HANDLE m = Mutex_val(mut); HANDLE s = Condition_val(cond)->sem; HANDLE handles[2]; Condition_val(cond)->count ++; Begin_roots2(cond, mut) /* prevent deallocation of cond and mutex */ enter_blocking_section(); /* Release mutex */ ReleaseMutex(m); /* Wait for semaphore to be non-null, and decrement it. Simultaneously, re-acquire mutex. */ handles[0] = s; handles[1] = m; retcode = WaitForMultipleObjects(2, handles, TRUE, INFINITE); leave_blocking_section(); End_roots(); if (retcode == WAIT_FAILED) caml_wthread_error("Condition.wait"); return Val_unit; }
static int caml_mutex_compare(value wrapper1, value wrapper2) { HANDLE h1 = Mutex_val(wrapper1); HANDLE h2 = Mutex_val(wrapper2); return h1 == h2 ? 0 : h1 < h2 ? -1 : 1; }
static void caml_mutex_finalize(value mut) { CloseHandle(Mutex_val(mut)); }
static int caml_mutex_condition_compare(value wrapper1, value wrapper2) { st_mutex mut1 = Mutex_val(wrapper1); st_mutex mut2 = Mutex_val(wrapper2); return mut1 == mut2 ? 0 : mut1 < mut2 ? -1 : 1; }
static void caml_mutex_finalize(value wrapper) { st_mutex_destroy(Mutex_val(wrapper)); }