[Toss-devel-svn] SF.net SVN: toss:[1443] trunk/Toss

[<luk...@us...>]

Revision: 1443
          http://toss.svn.sourceforge.net/toss/?rev=1443&view=rev
Author:   lukaszkaiser
Date:     2011-05-16 17:40:23 +0000 (Mon, 16 May 2011)

Log Message:
-----------
Make parallel calls stable. Inefficient for now due to multi-threading cache misses.

Modified Paths:
--------------
    trunk/Toss/Formula/Aux.ml
    trunk/Toss/Formula/Aux.mli
    trunk/Toss/Play/GameTree.ml
    trunk/Toss/Server/ReqHandler.ml

Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml	2011-05-15 22:48:50 UTC (rev 1442)
+++ trunk/Toss/Formula/Aux.ml	2011-05-16 17:40:23 UTC (rev 1443)
@@ -660,16 +660,21 @@
         addr_arr.(0)
     with Not_found -> raise Host_not_found
 
-let toss_call (client_port, client_addr_s) f x =
-  let client_addr = get_inet_addr client_addr_s in
-  let client_sock = Unix.ADDR_INET (client_addr, client_port) in
-  let (cl_in_ch, cl_out_ch) = Unix.open_connection client_sock in
-  output_string cl_out_ch "COMP\n";
-  flush cl_out_ch;
-  Marshal.to_channel cl_out_ch (f, x) [Marshal.Closures];
-  flush cl_out_ch;
-  fun () ->
-    let res = Marshal.from_channel cl_in_ch in
-    Unix.shutdown_connection cl_in_ch;
-    res
+let toss_call (client_port, client_addr_s) f_in x =
+  try
+    let client_addr = get_inet_addr client_addr_s in
+    let client_sock = Unix.ADDR_INET (client_addr, client_port) in
+    let (cl_in_ch, cl_out_ch) = Unix.open_connection client_sock in
+    output_string cl_out_ch "COMP\n";
+    flush cl_out_ch;
+    let f a = try `Res (f_in a) with exn -> `Exn exn in
+    Marshal.to_channel cl_out_ch (f, x) [Marshal.Closures];
+    flush cl_out_ch;
+    (fun () ->
+      let res = Marshal.from_channel cl_in_ch in
+      Unix.shutdown_connection cl_in_ch;
+      match res with `Res r -> r | `Exn e -> raise e)
+  with Unix.Unix_error (e, f, s) ->
+    Printf.printf "Toss call failed: %s; %s %s\n%!" (Unix.error_message e) f s;
+    (fun () -> f_in x)
     

Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli	2011-05-15 22:48:50 UTC (rev 1442)
+++ trunk/Toss/Formula/Aux.mli	2011-05-16 17:40:23 UTC (rev 1443)
@@ -309,5 +309,8 @@
 (** Determine the internet address or raise Host_not_found. *)
 val get_inet_addr : string -> Unix.inet_addr
 
-(** Call a Toss Server on [port, server] to compute [f] on [x]. *)
+(** Call a Toss Server on [port, server] to compute [f] on [x]. BEWARE: 
+    (1) references are not sent, e.g. you must redo timeouts.
+    (2) on single-threaded servers handling calls (older Toss versions),
+        you have to collect the results, even on Exception in caller *)
 val toss_call : int * string -> ('a -> 'b) -> 'a -> (unit -> 'b)

Modified: trunk/Toss/Play/GameTree.ml
===================================================================
--- trunk/Toss/Play/GameTree.ml	2011-05-15 22:48:50 UTC (rev 1442)
+++ trunk/Toss/Play/GameTree.ml	2011-05-16 17:40:23 UTC (rev 1443)
@@ -14,8 +14,11 @@
     if l = 0 then [||] else if l = 1 then [|f a.(0)|] else (
       let (a1, a2) = (Array.sub a 0 (l/2+1), Array.sub a (l/2+1) (l-(l/2+1))) in
       let r1 = Aux.toss_call !parallel_toss (Array.map f) a1 in
-      let r2 = Array.map f a2 in
-      Array.append (r1 ()) (r2)
+      (* If the server handling COMP is single-threaded, they must wait for it!
+	 In such case replace the last line with the two lines below.
+	 try let r2 = Array.map f a2 in Array.append (r1 ()) (r2) with exn ->
+	 ignore (r1 ()); raise exn *)
+      let r2 = Array.map f a2 in Array.append (r1 ()) r2
     )
 
 (* Abstract game tree, just stores state and move information. *)

Modified: trunk/Toss/Server/ReqHandler.ml
===================================================================
--- trunk/Toss/Server/ReqHandler.ml	2011-05-15 22:48:50 UTC (rev 1442)
+++ trunk/Toss/Server/ReqHandler.ml	2011-05-16 17:40:23 UTC (rev 1443)
@@ -658,7 +658,7 @@
     | None ->
       if line_in = "COMP" then
 	let res = Marshal.from_channel in_ch in
-	if !debug_level > 0 then Printf.printf "COMP\n%!";
+	if !debug_level > 0 then Printf.printf "COMP, %!";
 	("COMP", Some (Aux.Right res))
       else
 	(* We put endlines, encoded by '$', back into the message.
@@ -684,10 +684,14 @@
       (new_rstate, continue) in
     match read_in_line in_ch with
       | (line, Some (Aux.Right (f, x))) when line = "COMP" ->
-	let res = f x in
-	Marshal.to_channel out_ch res [Marshal.Closures];
-	flush out_ch;
-	(rstate, true)
+	(match Unix.fork () with
+	  | 0 (* child *) -> 
+	    let res = f x in
+	    Marshal.to_channel out_ch res [Marshal.Closures];
+	    flush out_ch;
+	    (rstate, false)
+	  | _ (* parent *) -> (rstate, true)
+	)
       | (line, Some (Aux.Left (cmd, head, msg, ck))) when line = "HTTP" ->
 	(match handle_http_msg rstate cmd head msg ck with
 	  | Aux.Left ((state, resp)) -> report (state, resp) true


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.