summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--otherlibs/threads/Tests/Makefile6
-rw-r--r--otherlibs/threads/Tests/testio.ml4
-rw-r--r--otherlibs/threads/pervasives.ml39
-rw-r--r--otherlibs/threads/scheduler.c20
-rw-r--r--otherlibs/threads/threadUnix.ml7
-rw-r--r--otherlibs/threads/threadUnix.mli7
6 files changed, 37 insertions, 46 deletions
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
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-19 15:52:50 +0000