diff --git a/otherlibs/threads/Tests/Makefile b/otherlibs/threads/Tests/Makefile index 4f6d56f5e..f1ff41abb 100644 --- a/otherlibs/threads/Tests/Makefile +++ b/otherlibs/threads/Tests/Makefile @@ -2,6 +2,8 @@ PROGS=test1.byt test2.byt test3.byt test4.byt test5.byt test6.byt \ test7.byt test8.byt test9.byt testA.byt sieve.byt \ testio.byt testsocket.byt testwait.byt testsignal.byt +CAMLC=../../../boot/ocamlrun ../../../ocamlc -I .. -I ../../../stdlib -I ../../unix + include ../../../config/Makefile all: $(PROGS) @@ -10,11 +12,11 @@ clean: rm -f *.cm* *.byt sorts.byt: sorts.ml - ocamlc -custom -o sorts.byt -I .. -I ../../graph threads.cma graphics.cma sorts.ml ../libthreads.a ../../graph/libgraphics.a $(X11_LINK) + $(CAMLC) -custom -o sorts.byt -I ../../graph threads.cma graphics.cma sorts.ml ../libthreads.a ../../graph/libgraphics.a $(X11_LINK) .SUFFIXES: .ml .byt .ml.byt: - ocamlc -custom -o $*.byt -I .. -I ../../unix unix.cma threads.cma $*.ml ../libthreads.a ../../unix/libunix.a + $(CAMLC) -custom -o $*.byt unix.cma threads.cma $*.ml ../libthreads.a ../../unix/libunix.a $(PROGS): ../threads.cma ../libthreads.a diff --git a/otherlibs/threads/Tests/testio.ml b/otherlibs/threads/Tests/testio.ml index f6bda60ae..f7610c0cd 100644 --- a/otherlibs/threads/Tests/testio.ml +++ b/otherlibs/threads/Tests/testio.ml @@ -5,8 +5,8 @@ let test msg producer consumer src dst = let ic = open_in_bin src in let oc = open_out_bin dst in let (in_fd, out_fd) = ThreadUnix.pipe() in - let ipipe = ThreadUnix.in_channel_of_descr in_fd in - let opipe = ThreadUnix.out_channel_of_descr out_fd in + let ipipe = Unix.in_channel_of_descr in_fd in + let opipe = Unix.out_channel_of_descr out_fd in let prod = Thread.create producer (ic, opipe) in let cons = Thread.create consumer (ipipe, oc) in Thread.join prod; diff --git a/otherlibs/threads/pervasives.ml b/otherlibs/threads/pervasives.ml index 35494f515..934697ff8 100644 --- a/otherlibs/threads/pervasives.ml +++ b/otherlibs/threads/pervasives.ml @@ -158,8 +158,8 @@ let rec (@) l1 l2 = type in_channel type out_channel -external open_descriptor_out: int -> out_channel = "open_descriptor" -external open_descriptor_in: int -> in_channel = "open_descriptor" +external open_descriptor_out: int -> out_channel = "caml_open_descriptor" +external open_descriptor_in: int -> in_channel = "caml_open_descriptor" let stdin = open_descriptor_in 0 let stdout = open_descriptor_out 1 @@ -205,14 +205,14 @@ let open_out name = let open_out_bin name = open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o666 name -external flush_partial : out_channel -> bool = "flush_partial" +external flush_partial : out_channel -> bool = "caml_flush_partial" let rec flush oc = wait_outchan oc (-1); if flush_partial oc then () else flush oc external unsafe_output_partial : out_channel -> string -> int -> int -> int - = "output_partial" + = "caml_output_partial" let rec unsafe_output oc buf pos len = if len > 0 then begin @@ -221,8 +221,9 @@ let rec unsafe_output oc buf pos len = unsafe_output oc buf (pos + written) (len - written) end -external output_char_blocking : out_channel -> char -> unit = "output_char" -external output_byte_blocking : out_channel -> int -> unit = "output_char" +external output_char_blocking : out_channel -> char -> unit + = "caml_output_char" +external output_byte_blocking : out_channel -> int -> unit = "caml_output_char" let output_char oc c = wait_outchan oc 1; output_char_blocking oc c @@ -242,16 +243,18 @@ let output_binary_int oc n = output_byte oc (n asr 8); output_byte oc n -external marshal_to_string : 'a -> unit list -> string = "output_value_to_string" +external marshal_to_string : 'a -> unit list -> string + = "output_value_to_string" + let output_value oc v = output_string oc (marshal_to_string v []) -external seek_out_blocking : out_channel -> int -> unit = "seek_out" +external seek_out_blocking : out_channel -> int -> unit = "caml_seek_out" let seek_out oc pos = flush oc; seek_out_blocking oc pos -external pos_out : out_channel -> int = "pos_out" -external out_channel_length : out_channel -> int = "channel_size" -external close_out_channel : out_channel -> unit = "close_channel" +external pos_out : out_channel -> int = "caml_pos_out" +external out_channel_length : out_channel -> int = "caml_channel_size" +external close_out_channel : out_channel -> unit = "caml_close_channel" let close_out oc = flush oc; close_out_channel oc @@ -266,13 +269,13 @@ let open_in name = let open_in_bin name = open_in_gen [Open_rdonly; Open_binary] 0 name -external input_char_blocking : in_channel -> char = "input_char" -external input_byte_blocking : in_channel -> int = "input_char" +external input_char_blocking : in_channel -> char = "caml_input_char" +external input_byte_blocking : in_channel -> int = "caml_input_char" let input_char ic = wait_inchan ic; input_char_blocking ic external unsafe_input_blocking : in_channel -> string -> int -> int -> int - = "input" + = "caml_input" let unsafe_input ic s ofs len = wait_inchan ic; unsafe_input_blocking ic s ofs len @@ -336,10 +339,10 @@ let input_value ic = really_input ic buffer 20 bsize; unmarshal buffer 0 -external seek_in : in_channel -> int -> unit = "seek_in" -external pos_in : in_channel -> int = "pos_in" -external in_channel_length : in_channel -> int = "channel_size" -external close_in : in_channel -> unit = "close_channel" +external seek_in : in_channel -> int -> unit = "caml_seek_in" +external pos_in : in_channel -> int = "caml_pos_in" +external in_channel_length : in_channel -> int = "caml_channel_size" +external close_in : in_channel -> unit = "caml_close_channel" (* Output functions on standard output *) diff --git a/otherlibs/threads/scheduler.c b/otherlibs/threads/scheduler.c index 74e2bfac1..ec2038ff3 100644 --- a/otherlibs/threads/scheduler.c +++ b/otherlibs/threads/scheduler.c @@ -124,15 +124,14 @@ static void thread_scan_roots(action) scanning_action action; { thread_t th; - register value * sp; + /* Scan all active descriptors */ (*action)((value) curr_thread, (value *) &curr_thread); - /* Don't scan curr_thread->sp, this has already been done */ + /* Don't scan curr_thread->sp, this has already been done. + Don't scan local roots either, for the same reason. */ for (th = curr_thread->next; th != curr_thread; th = th->next) { (*action)((value) th, (value *) &th); - for (sp = th->sp; sp < th->stack_high; sp++) { - (*action)(*sp, sp); - } + do_local_roots(action, th->sp, th->stack_high, NULL); } /* Hook */ if (prev_scan_roots_hook != NULL) (*prev_scan_roots_hook)(action); @@ -456,16 +455,17 @@ value thread_select(arg) /* ML */ /* Primitives to implement suspension on buffered channels */ -value thread_inchan_ready(chan) /* ML */ - struct channel * chan; +value thread_inchan_ready(vchan) /* ML */ + value vchan; { + struct channel * chan = Channel(vchan); return Val_bool(chan->curr < chan->max); } -value thread_outchan_ready(chan, vsize) /* ML */ - struct channel * chan; - value vsize; +value thread_outchan_ready(vchan, vsize) /* ML */ + value vchan, vsize; { + struct channel * chan = Channel(vchan); long size = Long_val(vsize); /* Negative size means we want to flush the buffer entirely */ if (size < 0) { diff --git a/otherlibs/threads/threadUnix.ml b/otherlibs/threads/threadUnix.ml index 7a4f1f3db..a136ab23c 100644 --- a/otherlibs/threads/threadUnix.ml +++ b/otherlibs/threads/threadUnix.ml @@ -70,13 +70,6 @@ let timed_write fd buff ofs len timeout = let select = Thread.select -(*** Interfacing with the standard input/output library *) - -external in_channel_of_descr : Unix.file_descr -> in_channel - = "open_descriptor" -external out_channel_of_descr : Unix.file_descr -> out_channel - = "open_descriptor" - (*** Pipes *) let pipe() = diff --git a/otherlibs/threads/threadUnix.mli b/otherlibs/threads/threadUnix.mli index d878dece8..973d2d49f 100644 --- a/otherlibs/threads/threadUnix.mli +++ b/otherlibs/threads/threadUnix.mli @@ -49,13 +49,6 @@ val select : Unix.file_descr list -> float -> Unix.file_descr list * Unix.file_descr list * Unix.file_descr list -(*** Interfacing with the standard input/output library *) - -external in_channel_of_descr : Unix.file_descr -> in_channel - = "open_descriptor" -external out_channel_of_descr : Unix.file_descr -> out_channel - = "open_descriptor" - (*** Pipes and redirections *) val pipe : unit -> Unix.file_descr * Unix.file_descr