1996-04-02 00:41:32 -08:00
|
|
|
(* Classic producer-consumer *)
|
|
|
|
|
|
|
|
type 'a prodcons =
|
|
|
|
{ buffer: 'a array;
|
|
|
|
lock: Mutex.t;
|
|
|
|
mutable readpos: int;
|
|
|
|
mutable writepos: int;
|
|
|
|
notempty: Condition.t;
|
|
|
|
notfull: Condition.t }
|
|
|
|
|
1996-04-29 07:06:05 -07:00
|
|
|
let create size init =
|
|
|
|
{ buffer = Array.create size init;
|
|
|
|
lock = Mutex.create();
|
1996-04-02 00:41:32 -08:00
|
|
|
readpos = 0;
|
|
|
|
writepos = 0;
|
1996-04-29 07:06:05 -07:00
|
|
|
notempty = Condition.create();
|
|
|
|
notfull = Condition.create() }
|
1996-04-02 00:41:32 -08:00
|
|
|
|
|
|
|
let put p data =
|
|
|
|
Mutex.lock p.lock;
|
|
|
|
while (p.writepos + 1) mod Array.length p.buffer = p.readpos do
|
|
|
|
Condition.wait p.notfull p.lock
|
|
|
|
done;
|
|
|
|
p.buffer.(p.writepos) <- data;
|
|
|
|
p.writepos <- (p.writepos + 1) mod Array.length p.buffer;
|
|
|
|
Condition.signal p.notempty;
|
|
|
|
Mutex.unlock p.lock
|
|
|
|
|
|
|
|
let get p =
|
|
|
|
Mutex.lock p.lock;
|
|
|
|
while p.writepos = p.readpos do
|
|
|
|
Condition.wait p.notempty p.lock
|
|
|
|
done;
|
|
|
|
let data = p.buffer.(p.readpos) in
|
|
|
|
p.readpos <- (p.readpos + 1) mod Array.length p.buffer;
|
|
|
|
Condition.signal p.notfull;
|
|
|
|
Mutex.unlock p.lock;
|
|
|
|
data
|
|
|
|
|
|
|
|
(* Test *)
|
|
|
|
|
1996-04-29 07:06:05 -07:00
|
|
|
let buff = create 20 0
|
1996-04-02 00:41:32 -08:00
|
|
|
|
|
|
|
let rec produce n =
|
|
|
|
print_int n; print_string "-->"; print_newline();
|
|
|
|
put buff n;
|
1999-12-23 09:33:59 -08:00
|
|
|
if n < 10000 then produce (n+1)
|
1996-04-02 00:41:32 -08:00
|
|
|
|
|
|
|
let rec consume () =
|
|
|
|
let n = get buff in
|
|
|
|
print_string "-->"; print_int n; print_newline();
|
1999-12-23 09:33:59 -08:00
|
|
|
if n < 10000 then consume ()
|
1996-04-02 00:41:32 -08:00
|
|
|
|
|
|
|
let _ =
|
1996-04-29 07:06:05 -07:00
|
|
|
Thread.create produce 0;
|
1999-12-23 09:33:59 -08:00
|
|
|
consume ()
|