CAMLprim value caml_condition_new(value unit) { value cond; cond = alloc_custom(&caml_condition_ops, sizeof(struct caml_condvar), 1, Max_condition_number); Condition_val(cond)->sem = CreateSemaphore(NULL, 0, 0x7FFFFFFF, NULL); if (Condition_val(cond)->sem == NULL) caml_wthread_error("Condition.create"); Condition_val(cond)->count = 0; return cond; }
CAMLprim value caml_condition_signal(value cond) { HANDLE s = Condition_val(cond)->sem; if (Condition_val(cond)->count > 0) { Condition_val(cond)->count --; /* Increment semaphore by 1, waking up one waiter */ ReleaseSemaphore(s, 1, NULL); } return Val_unit; }
CAMLprim value caml_condition_broadcast(value cond) { HANDLE s = Condition_val(cond)->sem; uintnat c = Condition_val(cond)->count; if (c > 0) { Condition_val(cond)->count = 0; /* Increment semaphore by c, waking up all waiters */ ReleaseSemaphore(s, c, NULL); } return Val_unit; }
CAMLprim value caml_condition_signal(value cond) { HANDLE s = Condition_val(cond)->sem; if (Condition_val(cond)->count > 0) { Condition_val(cond)->count --; Begin_root(cond) /* prevent deallocation of cond */ enter_blocking_section(); /* Increment semaphore by 1, waking up one waiter */ ReleaseSemaphore(s, 1, NULL); leave_blocking_section(); End_roots(); } return Val_unit; }
CAMLprim value caml_condition_broadcast(value cond) { HANDLE s = Condition_val(cond)->sem; uintnat c = Condition_val(cond)->count; if (c > 0) { Condition_val(cond)->count = 0; Begin_root(cond) /* prevent deallocation of cond */ enter_blocking_section(); /* Increment semaphore by c, waking up all waiters */ ReleaseSemaphore(s, c, NULL); leave_blocking_section(); End_roots(); } return Val_unit; }
CAMLprim value caml_condition_new(value unit) /* ML */ { st_condvar cond = NULL; /* suppress warning */ value wrapper; st_check_error(st_condvar_create(&cond), "Condition.create"); wrapper = alloc_custom(&caml_condition_ops, sizeof(st_condvar *), 1, Max_condition_number); Condition_val(wrapper) = cond; return wrapper; }
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; }
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; }
static int caml_condition_compare(value wrapper1, value wrapper2) { HANDLE h1 = Condition_val(wrapper1)->sem; HANDLE h2 = Condition_val(wrapper2)->sem; return h1 == h2 ? 0 : h1 < h2 ? -1 : 1; }
static void caml_condition_finalize(value cond) { CloseHandle(Condition_val(cond)->sem); }
CAMLprim value caml_condition_broadcast(value wrapper) /* ML */ { st_check_error(st_condvar_broadcast(Condition_val(wrapper)), "Condition.signal"); return Val_unit; }
static void caml_condition_finalize(value wrapper) { st_condvar_destroy(Condition_val(wrapper)); }