Exemplo n.º 1
0
Arquivo: win32.c Projeto: OpenXT/ocaml
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;
}
Exemplo n.º 2
0
Arquivo: win32.c Projeto: OpenXT/ocaml
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;
}
Exemplo n.º 3
0
Arquivo: win32.c Projeto: OpenXT/ocaml
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;
}
Exemplo n.º 4
0
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;
}
Exemplo n.º 5
0
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;
}
Exemplo n.º 6
0
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;
}
Exemplo n.º 7
0
Arquivo: win32.c Projeto: OpenXT/ocaml
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;
}
Exemplo n.º 8
0
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;
}
Exemplo n.º 9
0
Arquivo: win32.c Projeto: OpenXT/ocaml
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;
}
Exemplo n.º 10
0
Arquivo: win32.c Projeto: OpenXT/ocaml
static void caml_condition_finalize(value cond)
{
  CloseHandle(Condition_val(cond)->sem);
}
Exemplo n.º 11
0
CAMLprim value caml_condition_broadcast(value wrapper)           /* ML */
{
  st_check_error(st_condvar_broadcast(Condition_val(wrapper)),
                 "Condition.signal");
  return Val_unit;
}
Exemplo n.º 12
0
static void caml_condition_finalize(value wrapper)
{
  st_condvar_destroy(Condition_val(wrapper));
}