[Caml-list] Problem with threads & netclient

[Artem Prisyaznuk <tema@sit.kiev.ua>]

I write function for multithread list maping.
I use it for get some web pages. But sometime it's don't 
work properly, after get a several hundred pages,
my program exit by segfault. 

I compile it under Linux, with pthread, and I use netclient
library, Ocaml version 3.04.

Program here:
============================================================
type 'a th_res = Init | Val of 'a | Exn of exn;;

let map ?(max = 10) (fun_t : 'a -> 'b) (lst : 'a list) =
  let mtx_count = Mutex.create () in
  let count = ref 0 in
  let count_incr () =
    Mutex.lock mtx_count; incr count; Mutex.unlock mtx_count
  in
  let count_decr () =
    Mutex.lock mtx_count; decr count; Mutex.unlock mtx_count
  in
  let cond_exit = Condition.create () in
  let thr_f ref_res f arg =
    ref_res :=
      begin try Val (f arg) with
        ex -> prerr_endline (Printexc.to_string ex); flush stderr; Exn ex
      end;
    count_decr ();
    Condition.signal cond_exit
  in
  let thds =
    List.map
      (fun arg ->
         let res = ref Init in
         Mutex.lock mtx_count;
         if !count < max then () else Condition.wait cond_exit mtx_count;
         Mutex.unlock mtx_count;
         try
           let r = Some (Thread.create (thr_f res fun_t) arg), res in
           incr count; r
         with
           ex ->
             prerr_endline (Printexc.to_string ex);
             flush stderr;
             res := Exn ex;
             None, res)
      lst
  in
  List.map
    (fun (th, res) ->
       begin match th with
         Some t -> Thread.join t
       | None -> ()
       end;
       !res)
    thds
;;
let prlog s = print_string s; flush stdout;;
open Http_client;;
let http_get link =
  let get = new get link in
  let pipe = new pipeline in
  pipe#add get;
  begin try pipe#run () with
    any -> pipe#reset (); raise any
  end;
  pipe#reset ();
  get#get_resp_body ()
;;

let f (i, adr) =
  Printf.printf "."; flush stdout; String.length (http_get adr)
;;

let make_lst adr len =
  let rec mk_aux len accum =
    if len = 0 then accum else mk_aux (len - 1) ((len, adr) :: accum)
  in
  mk_aux len []
;;
 
let test count url =
  let args = make_lst url count in
  let res = map ~max:4 f args in
  print_endline "=================\n";
  List.iter2
    (fun (i, a) r ->
       match r with
         Val r -> Printf.printf "%3d. %s = %d\n" i a r
       | Init -> Printf.printf "%3d. %s = Init\n" i a
       | Exn ex ->
           Printf.printf "%3d. %s = Exn %s\n" i a (Printexc.to_string ex))
    args res
;;
let url = ref "";;
let count = ref 0;;
let replay = ref 0;;
let spec =
  ["-u", Arg.String (fun s -> url := s), "- url";
   "-c", Arg.Int (fun i -> count := i), "- size of list";
   "-r", Arg.Int (fun r -> replay := r), "- count of repaly"]
;;
Arg.parse spec (fun _ -> ()) "Test Threads\n";;

for i = 1 to !replay do
  test !count !url;
  print_endline "\n\nnext_loop *************************\n\n"
done;;
============================================================

I call it:

	./prog -l 3000 -c 3 -u http://localhost/manual/index.html

Where's problem?

-- 
Artem Prisyaznuk
tema@sit.kiev.ua
-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners