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; }
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; }
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; }
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; }
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; }