Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Adaptation pour ocamlopt. Verrouillage des channels maintenant fait en C, et plus en ML 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1692 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 1997-08-29 15:05:51 +00:00
parent 0ee4feb9bd
commit 891e4e9c27
6 changed files with 37 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
otherlibs/threads/Tests/Makefile
View File

@ -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

4
otherlibs/threads/Tests/testio.ml
View File

@ -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;

39
otherlibs/threads/pervasives.ml
View File

@ -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 *)

20
otherlibs/threads/scheduler.c
View File

@ -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) {

7
otherlibs/threads/threadUnix.ml
View File

@ -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() =

7
otherlibs/threads/threadUnix.mli
View File

@ -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