Exemplo n.º 1
0
Arquivo: win32.c Projeto: OpenXT/ocaml
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;
}
Exemplo n.º 2
0
Arquivo: win32.c Projeto: OpenXT/ocaml
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;
}
Exemplo n.º 3
0
Arquivo: win32.c Projeto: OpenXT/ocaml
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);
}
Exemplo n.º 4
0
Arquivo: win32.c Projeto: OpenXT/ocaml
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;
}
Exemplo n.º 5
0
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;
}
Exemplo n.º 6
0
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;
}
Exemplo n.º 7
0
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;
}
Exemplo n.º 8
0
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;
}
Exemplo n.º 9
0
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;
}
Exemplo n.º 10
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.º 11
0
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;
}
Exemplo n.º 12
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.º 13
0
Arquivo: win32.c Projeto: OpenXT/ocaml
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;
}
Exemplo n.º 14
0
Arquivo: win32.c Projeto: OpenXT/ocaml
static void caml_mutex_finalize(value mut)
{
  CloseHandle(Mutex_val(mut));
}
Exemplo n.º 15
0
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;
}
Exemplo n.º 16
0
static void caml_mutex_finalize(value wrapper)
{
  st_mutex_destroy(Mutex_val(wrapper));
}