示例#1
0
文件: win32.c 项目: OpenXT/ocaml
static DWORD WINAPI caml_thread_start(void * arg)
{
  caml_thread_t th = (caml_thread_t) arg;
  value clos;

  /* Associate the thread descriptor with the thread */
  TlsSetValue(thread_descriptor_key, (void *) th);
  TlsSetValue(last_channel_locked_key, NULL);
  /* Acquire the global mutex and set up the stack variables */
  leave_blocking_section();
  /* Callback the closure */
  clos = Start_closure(th->descr);
  modify(&(Start_closure(th->descr)), Val_unit);
  callback_exn(clos, Val_unit);
  /* Remove th from the doubly-linked list of threads */
  th->next->prev = th->prev;
  th->prev->next = th->next;
  /* Release the main mutex (forever) */
  ReleaseMutex(caml_mutex);
#ifndef NATIVE_CODE
  /* Free the memory resources */
  stat_free(th->stack_low);
  if (th->backtrace_buffer != NULL) free(th->backtrace_buffer);
#endif
  /* Free the thread descriptor */
  stat_free(th);
  /* The thread now stops running */
  return 0;
}
示例#2
0
文件: st_stubs.c 项目: avsm/ocaml-ppa
static ST_THREAD_FUNCTION caml_thread_start(void * arg)
{
  caml_thread_t th = (caml_thread_t) arg;
  value clos;
#ifdef NATIVE_CODE
  struct longjmp_buffer termination_buf;
  char tos;
#endif

  /* Associate the thread descriptor with the thread */
  st_tls_set(thread_descriptor_key, (void *) th);
  /* Acquire the global mutex */
  leave_blocking_section();
#ifdef NATIVE_CODE
  /* Record top of stack (approximative) */
  th->top_of_stack = &tos;
  /* Setup termination handler (for caml_thread_exit) */
  if (sigsetjmp(termination_buf.buf, 0) == 0) {
    th->exit_buf = &termination_buf;
#endif
    /* Callback the closure */
    clos = Start_closure(th->descr);
    modify(&(Start_closure(th->descr)), Val_unit);
    callback_exn(clos, Val_unit);
    caml_thread_stop();
#ifdef NATIVE_CODE
  }
#endif
  /* The thread now stops running */
  return 0;
}  
示例#3
0
文件: win32.c 项目: OpenXT/ocaml
CAMLprim value caml_thread_new(value clos)
{
  caml_thread_t th;
  value vthread = Val_unit;
  value descr;
  DWORD th_id;

  Begin_roots2 (clos, vthread)
    /* Create a finalized value to hold thread handle */
    vthread = alloc_final(sizeof(struct caml_thread_handle) / sizeof(value),
                          caml_thread_finalize, 1, 1000);
    ((struct caml_thread_handle *)vthread)->handle = NULL;
    /* Create a descriptor for the new thread */
    descr = alloc_tuple(sizeof(struct caml_thread_descr) / sizeof(value));
    Ident(descr) = Val_long(thread_next_ident);
    Start_closure(descr) = clos;
    Threadhandle(descr) = (struct caml_thread_handle *) vthread;
    thread_next_ident++;
    /* Create an info block for the current thread */
    th = (caml_thread_t) stat_alloc(sizeof(struct caml_thread_struct));
    th->descr = descr;
#ifdef NATIVE_CODE
    th->bottom_of_stack = NULL;
    th->exception_pointer = NULL;
    th->local_roots = NULL;
#else
    /* Allocate the stacks */
    th->stack_low = (value *) stat_alloc(Thread_stack_size);
    th->stack_high = th->stack_low + Thread_stack_size / sizeof(value);
    th->stack_threshold = th->stack_low + Stack_threshold / sizeof(value);
    th->sp = th->stack_high;
    th->trapsp = th->stack_high;
    th->local_roots = NULL;
    th->external_raise = NULL;
    th->backtrace_pos = 0;
    th->backtrace_buffer = NULL;
    th->backtrace_last_exn = Val_unit;
#endif
    /* Add thread info block to the list of threads */
    th->next = curr_thread->next;
    th->prev = curr_thread;
    curr_thread->next->prev = th;
    curr_thread->next = th;
    /* Fork the new thread */
    th->wthread =
      CreateThread(NULL, 0, caml_thread_start, (void *) th, 0, &th_id);
    if (th->wthread == NULL) {
      /* Fork failed, remove thread info block from list of threads */
      th->next->prev = curr_thread;
      curr_thread->next = th->next;
#ifndef NATIVE_CODE
      stat_free(th->stack_low);
#endif
      stat_free(th);
      caml_wthread_error("Thread.create");
    }
    ((struct caml_thread_handle *)vthread)->handle = th->wthread;
  End_roots();
  return descr;
}
示例#4
0
文件: win32.c 项目: OpenXT/ocaml
CAMLprim value caml_thread_initialize(value unit)
{
  value vthread = Val_unit;
  value descr;
  HANDLE tick_thread;
  DWORD th_id;

  /* Protect against repeated initialization (PR#1325) */
  if (curr_thread != NULL) return Val_unit;
  Begin_root (vthread);
    /* Initialize the main mutex and acquire it */
    caml_mutex = CreateMutex(NULL, TRUE, NULL);
    if (caml_mutex == NULL) caml_wthread_error("Thread.init");
    /* Initialize the TLS keys */
    thread_descriptor_key = TlsAlloc();
    last_channel_locked_key = TlsAlloc();
    /* Create a finalized value to hold thread handle */
    vthread = alloc_final(sizeof(struct caml_thread_handle) / sizeof(value),
                          caml_thread_finalize, 1, 1000);
    ((struct caml_thread_handle *)vthread)->handle = NULL;
    /* Create a descriptor for the current thread */
    descr = alloc_tuple(sizeof(struct caml_thread_descr) / sizeof(value));
    Ident(descr) = Val_long(thread_next_ident);
    Start_closure(descr) = Val_unit;
    Threadhandle(descr) = (struct caml_thread_handle *) vthread;
    thread_next_ident++;
    /* Create an info block for the current thread */
    curr_thread =
      (caml_thread_t) stat_alloc(sizeof(struct caml_thread_struct));
    DuplicateHandle(GetCurrentProcess(), GetCurrentThread(),
                    GetCurrentProcess(), &(curr_thread->wthread),
                    0, FALSE, DUPLICATE_SAME_ACCESS);
    if (curr_thread->wthread == NULL) caml_wthread_error("Thread.init");
    ((struct caml_thread_handle *)vthread)->handle = curr_thread->wthread;
    curr_thread->descr = descr;
    curr_thread->next = curr_thread;
    curr_thread->prev = curr_thread;
    /* The stack-related fields will be filled in at the next
       enter_blocking_section */
    /* Associate the thread descriptor with the thread */
    TlsSetValue(thread_descriptor_key, (void *) curr_thread);
    /* Set up the hooks */
    prev_scan_roots_hook = scan_roots_hook;
    scan_roots_hook = caml_thread_scan_roots;
    enter_blocking_section_hook = caml_thread_enter_blocking_section;
    leave_blocking_section_hook = caml_thread_leave_blocking_section;
    try_leave_blocking_section_hook = caml_thread_try_leave_blocking_section;
    caml_channel_mutex_free = caml_io_mutex_free;
    caml_channel_mutex_lock = caml_io_mutex_lock;
    caml_channel_mutex_unlock = caml_io_mutex_unlock;
    caml_channel_mutex_unlock_exn = caml_io_mutex_unlock_exn;
    /* Fork the tick thread */
    tick_thread = CreateThread(NULL, 0, caml_thread_tick, NULL, 0, &th_id);
    if (tick_thread == NULL) caml_wthread_error("Thread.init");
    CloseHandle(tick_thread);
  End_roots();
  return Val_unit;
}
示例#5
0
文件: st_stubs.c 项目: avsm/ocaml-ppa
static value caml_thread_new_descriptor(value clos)
{
  value mu = Val_unit;
  value descr;
  Begin_roots2 (clos, mu)
    /* Create and initialize the termination semaphore */
    mu = caml_threadstatus_new();
    /* Create a descriptor for the new thread */
    descr = alloc_small(3, 0);
    Ident(descr) = Val_long(thread_next_ident);
    Start_closure(descr) = clos;
    Terminated(descr) = mu;
    thread_next_ident++;
  End_roots();
  return descr;
}