Debugging intensif (sur V6)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1727 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

5 files changed, 24 insertions, 21 deletions

diff --git a/otherlibs/systhreads/Makefile.nt b/otherlibs/systhreads/Makefile.nt
index 7cd4ae0cd..ff8f1f24c 100644
--- a/otherlibs/systhreads/Makefile.nt
+++ b/otherlibs/systhreads/Makefile.nt
@@ -48,7 +48,7 @@ clean: partialclean
 install:
 	cp libthreads.lib $(LIBDIR)/libthreads.lib
 	if not exist $(LIBDIR)\threads mkdir $(LIBDIR)\threads
-	cp thread.cmi mutex.cmi condition.cmi event.cmi threadUnix.cmi threads.cma stdlib.cma $(LIBDIR)/threads
+	cp thread.cmi mutex.cmi condition.cmi event.cmi threadUnix.cmi threads.cma $(LIBDIR)/threads
 
 installopt:
 
diff --git a/otherlibs/systhreads/thread.mlp b/otherlibs/systhreads/thread.mlp
index 9859c0c5a..e760907e3 100644
--- a/otherlibs/systhreads/thread.mlp
+++ b/otherlibs/systhreads/thread.mlp
@@ -23,7 +23,6 @@ external self : unit -> t = "caml_thread_self"
 external id : t -> int = "caml_thread_id"
 external exit : unit -> unit = "caml_thread_exit"
 external join : t -> unit = "caml_thread_join"
-external detach : t -> unit = "caml_thread_detach"
 external kill : t -> unit = "caml_thread_kill"
 
 (* For new, make sure the function passed to thread_new never
diff --git a/otherlibs/systhreads/threadUnix.ml b/otherlibs/systhreads/threadUnix.ml
index 27012731c..2e0546522 100644
--- a/otherlibs/systhreads/threadUnix.ml
+++ b/otherlibs/systhreads/threadUnix.ml
@@ -21,9 +21,8 @@ external execv : string -> string array -> unit = "unix_execv"
 external execve : string -> string array -> string array -> unit
            = "unix_execve"
 external execvp : string -> string array -> unit = "unix_execvp"
-external wait : unit -> int * process_status = "unix_wait"
-external waitpid : wait_flag list -> int -> int * process_status
-           = "unix_waitpid"
+let wait = Unix.wait
+let waitpid = Unix.waitpid
 let system = Unix.system
 let read = Unix.read
 let write = Unix.write
diff --git a/otherlibs/systhreads/threadUnix.mli b/otherlibs/systhreads/threadUnix.mli
index ac092274f..89976b97d 100644
--- a/otherlibs/systhreads/threadUnix.mli
+++ b/otherlibs/systhreads/threadUnix.mli
@@ -25,9 +25,8 @@ external execv : string -> string array -> unit = "unix_execv"
 external execve : string -> string array -> string array -> unit
            = "unix_execve"
 external execvp : string -> string array -> unit = "unix_execvp"
-external wait : unit -> int * Unix.process_status = "unix_wait"
-external waitpid : Unix.wait_flag list -> int -> int * Unix.process_status
-           = "unix_waitpid"
+val wait : unit -> int * Unix.process_status
+val waitpid : Unix.wait_flag list -> int -> int * Unix.process_status
 val system : string -> Unix.process_status
 
 (*** Basic input/output *)
diff --git a/otherlibs/systhreads/win32.c b/otherlibs/systhreads/win32.c
index 1017c601d..38db9f979 100644
--- a/otherlibs/systhreads/win32.c
+++ b/otherlibs/systhreads/win32.c
@@ -112,17 +112,21 @@ static void caml_thread_scan_roots(scanning_action action)
 {
   caml_thread_t th;
 
-  /* Scan the stacks, except that of the current thread (already done). */
-  for (th = curr_thread->next; th != curr_thread; th = th->next) {
+  th = curr_thread;
+  do {
     (*action)(th->descr, &th->descr);
+    /* Don't rescan the stack of the current thread, it was done already */
+    if (th != curr_thread) {
 #ifdef NATIVE_CODE
-    if (th->bottom_of_stack == NULL) continue;
-    do_local_roots(action, th->last_return_address,
-                   th->bottom_of_stack, th->local_roots);
+      if (th->bottom_of_stack == NULL) continue;
+      do_local_roots(action, th->last_return_address,
+		     th->bottom_of_stack, th->local_roots);
 #else
-    do_local_roots(action, th->sp, th->stack_high, th->local_roots);
+      do_local_roots(action, th->sp, th->stack_high, th->local_roots);
 #endif
-  }
+    }
+    th = th->next;
+  } while (th != curr_thread);
   /* Hook */
   if (prev_scan_roots_hook != NULL) (*prev_scan_roots_hook)(action);
 }
@@ -263,10 +267,11 @@ value caml_thread_initialize(value unit)   /* ML */
     caml_mutex = CreateMutex(NULL, TRUE, NULL);
     if (caml_mutex == NULL) caml_wthread_error("Thread.init");
     /* Create a finalized value to hold thread handle */
-    vthread = alloc_final(2, caml_thread_finalize, 1, 1000);
+    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(3);
+    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;
@@ -323,7 +328,7 @@ static void caml_thread_start(caml_thread_t th)
   /* Cleanup: free the thread resources */
   caml_thread_cleanup(th);
   /* Release the main mutex */
-  ReleaseMutex(caml_mutex);
+  enter_blocking_section();
 }  
 
 value caml_thread_new(value clos)          /* ML */
@@ -335,10 +340,11 @@ value caml_thread_new(value clos)          /* ML */
 
   Begin_roots2 (clos, vthread)
     /* Create a finalized value to hold thread handle */
-    vthread = alloc_final(2, caml_thread_finalize, 1, 1000);
+    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(3);
+    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;
@@ -415,7 +421,7 @@ value caml_thread_join(value th)          /* ML */
 value caml_thread_exit(value unit)       /* ML */
 {
   caml_thread_cleanup(curr_thread);
-  ReleaseMutex(caml_mutex);
+  enter_blocking_section();
   ExitThread(0);
   return Val_unit;              /* never reached */
 }