diff options
| -rw-r--r-- | otherlibs/systhreads/Makefile.nt | 2 | ||||
| -rw-r--r-- | otherlibs/systhreads/thread.mlp | 1 | ||||
| -rw-r--r-- | otherlibs/systhreads/threadUnix.ml | 5 | ||||
| -rw-r--r-- | otherlibs/systhreads/threadUnix.mli | 5 | ||||
| -rw-r--r-- | otherlibs/systhreads/win32.c | 32 |
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 */ } |