Index: byterun/callback.h
===================================================================
--- byterun/callback.h	(revision 170)
+++ byterun/callback.h	(revision 177)
@@ -44,6 +44,10 @@
 CAMLextern void caml_main (char ** argv);
 CAMLextern void caml_startup (char ** argv);
 
+/* the following two functions return zero on failure and non-zero on success */
+CAMLextern int caml_c_thread_register(void);
+CAMLextern int caml_c_thread_unregister(void);
+
 CAMLextern int caml_callback_depth;
 
 #endif
Index: otherlibs/systhreads/win32.c
===================================================================
--- otherlibs/systhreads/win32.c	(revision 170)
+++ otherlibs/systhreads/win32.c	(revision 177)
@@ -98,9 +98,9 @@
 
 static caml_thread_t curr_thread = NULL;
 
-/* The global mutex used to ensure that at most one thread is running
-   Caml code */
-static HANDLE caml_mutex;
+/* The global synchronization object used to ensure that at most one thread is
+   running Caml code. We use critical section as it is faster than mutex. */
+static CRITICAL_SECTION caml_crit_sect;
 
 /* The key used for storing the thread descriptor in the specific data
    of the corresponding Posix thread. */
@@ -171,12 +171,12 @@
   curr_thread->backtrace_last_exn = backtrace_last_exn;
 #endif
   /* Release the global mutex */
-  ReleaseMutex(caml_mutex);
+  LeaveCriticalSection(&caml_crit_sect);
 }
 
 static void caml_thread_leave_blocking_section(void)
 {
-  WaitForSingleObject(caml_mutex, INFINITE);
+  EnterCriticalSection(&caml_crit_sect);
   /* Update curr_thread to point to the thread descriptor corresponding
      to the thread currently executing */
   curr_thread = TlsGetValue(thread_descriptor_key);
@@ -257,6 +257,8 @@
 
 /* The "tick" thread fakes a signal at regular intervals. */
 
+static HANDLE tick_thread;
+
 static DWORD WINAPI caml_thread_tick(void * arg)
 {
   while(1) {
@@ -282,15 +284,14 @@
 {
   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");
+    InitializeCriticalSection(&caml_crit_sect);
+    EnterCriticalSection(&caml_crit_sect);
     /* Initialize the TLS keys */
     thread_descriptor_key = TlsAlloc();
     last_channel_locked_key = TlsAlloc();
@@ -332,11 +333,26 @@
     /* 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 void caml_thread_remove_info(caml_thread_t th)
+{
+  /* Remove th from the doubly-linked list of threads */
+  th->next->prev = th->prev;
+  th->prev->next = th->next;
+  /* Release the main mutex */
+  LeaveCriticalSection(&caml_crit_sect);
+#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);
+}
+
 /* Create a thread */
 
 static DWORD WINAPI caml_thread_start(void * arg)
@@ -353,23 +369,12 @@
   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);
+  caml_thread_remove_info(th);
   /* The thread now stops running */
   return 0;
 }
 
-CAMLprim value caml_thread_new(value clos)
+static value caml_thread_create_or_register(int create, value clos)
 {
   caml_thread_t th;
   value vthread = Val_unit;
@@ -412,24 +417,80 @@
     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 (create){
+      /* Fork the new thread */
+      th->wthread =
+        CreateThread(NULL, 0, caml_thread_start, (void *) th, 0, &th_id);
+    }
+    else {
+      /* Get the current thread handle */
+      DuplicateHandle(GetCurrentProcess(), GetCurrentThread(),
+                      GetCurrentProcess(), &(th->wthread),
+                      0, FALSE, DUPLICATE_SAME_ACCESS);
+      if (th->wthread != NULL){
+        /* Associate the thread descriptor with the thread */
+        TlsSetValue(thread_descriptor_key, (void *) th);
+        TlsSetValue(last_channel_locked_key, NULL);
+      }
+    }
     if (th->wthread == NULL) {
-      /* Fork failed, remove thread info block from list of threads */
+      /* Fork or attach 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");
+      th = NULL;
+      descr = Val_unit;
+      if (create){
+        caml_wthread_error("Thread.create");
+      }
     }
-    ((struct caml_thread_handle *)vthread)->handle = th->wthread;
+    if (th != NULL) ((struct caml_thread_handle *)vthread)->handle = th->wthread;
   End_roots();
   return descr;
 }
 
+/* Create a new thread */
+
+CAMLprim value caml_thread_new(value clos)
+{
+  return caml_thread_create_or_register(1, clos);
+}
+
+/* Register the current C-thread in Caml */
+
+int caml_c_thread_register()
+{
+  int success = 0;
+  if (TlsGetValue(thread_descriptor_key) == NULL){
+    /* Acquire the main mutex */
+    EnterCriticalSection(&caml_crit_sect);
+    if (caml_thread_create_or_register(0, Val_unit) != Val_unit)
+      success = 1;
+    /* Release the main mutex */
+    LeaveCriticalSection(&caml_crit_sect);
+  }
+  return success;
+}
+
+/* Unregister the current C-thread in Caml */
+
+int caml_c_thread_unregister()
+{
+  int success = 0;
+  caml_thread_t th = TlsGetValue(thread_descriptor_key);
+  if (th != NULL){
+    /* Acquire the main mutex */
+    EnterCriticalSection(&caml_crit_sect);
+    /* Also release the main mutex */
+    caml_thread_remove_info(th);
+    success = 1;
+  }
+  return success;
+}
+
 /* Return the current thread */
 
 CAMLprim value caml_thread_self(value unit)
@@ -662,3 +723,14 @@
   sprintf(errmsg, "%s: error code %lx", msg, GetLastError());
   raise_sys_error(copy_string(errmsg));
 }
+
+/* Cleanup */
+
+CAMLprim value caml_thread_cleanup(value unit)
+{
+  /* Brute-force termination is safe as the tick thread
+     just periodically updates some global variables  */
+  TerminateThread(tick_thread, 0);
+  CloseHandle(tick_thread);
+  return Val_unit;
+}
Index: otherlibs/systhreads/thread_win32.ml
===================================================================
--- otherlibs/systhreads/thread_win32.ml	(revision 170)
+++ otherlibs/systhreads/thread_win32.ml	(revision 177)
@@ -24,7 +24,7 @@
 external self : unit -> t = "caml_thread_self"
 external id : t -> int = "caml_thread_id"
 external join : t -> unit = "caml_thread_join"
-external thread_uncaught_exception : exn -> unit = 
+external thread_uncaught_exception : exn -> unit =
             "caml_thread_uncaught_exception"
 
 (* For new, make sure the function passed to thread_new never
@@ -75,3 +75,13 @@
 let sigmask cmd set = invalid_arg "Thread.sigmask: not implemented"
 let wait_signal set = invalid_arg "Thread.wait_signal: not implemented"
 
+(* Cleanup *)
+
+external thread_cleanup : unit -> unit = "caml_thread_cleanup"
+
+let _ =
+  at_exit
+    (fun () ->
+      thread_cleanup(); 
+      ignore(Sys.signal Sys.sigterm Sys.Signal_default)
+    )

Index: thread.ml
===================================================================
--- thread.ml	(.../vendor/ocaml-3.12.0/otherlibs/systhreads)	(revision 295)
+++ thread.ml	(.../trunk/otherlibs/systhreads)	(revision 295)
@@ -18,6 +18,7 @@
 type t
 
 external thread_initialize : unit -> unit = "caml_thread_initialize"
+external thread_cleanup : unit -> unit = "caml_thread_cleanup"
 external thread_new : (unit -> unit) -> t = "caml_thread_new"
 external thread_uncaught_exception : exn -> unit =
             "caml_thread_uncaught_exception"
@@ -58,7 +59,15 @@
 
 let _ =
   ignore(Sys.signal preempt_signal (Sys.Signal_handle preempt));
-  thread_initialize()
+  thread_initialize();
+  at_exit
+    (fun () ->
+        thread_cleanup();
+        (* In case of DLL-embedded Ocaml the preempt_signal handler will point to
+           nowhere after DLL unloading and an ancidental preempt_signal will crash
+           the main program. So restore the default handler. *)
+        ignore(Sys.signal preempt_signal Sys.Signal_default)
+    )
 
 (* Wait functions *)