Skip to content
Browse files

mutex changes in reacting

  • Loading branch information...
1 parent 1f4b00c commit 13268e50c5c3440ffaf5801b8f0f03470b68a727 @SylvainGBR committed Apr 27, 2012
Showing with 48 additions and 35 deletions.
  1. +48 −35 actorssg.ml
View
83 actorssg.ml
@@ -1,8 +1,7 @@
-let debug = true
-(* let debug_flag = ref false *)
-(* let debug fmt = *)
-(* if !debug_flag then Printf.eprintf fmt *)
-(* else Printf.ifprintf stderr fmt *)
+let debug_flag = ref false
+let debug fmt =
+ if !debug_flag then Printf.eprintf fmt
+ else Printf.ifprintf stderr fmt
type arg =
| Actor of actor
@@ -72,14 +71,14 @@ let actors = Hashtbl.create 1313 (* Should probably be a weak hashtbl *)
(* let machines = Hashtbl.create 97 *)
let mutex_lock mut =
- if debug then print_string "Locking. ";
+ debug "Locking. %!";
Mutex.lock mut;
- if debug then print_string "Locked. ";;
+ debug "Locked. %!";;
let mutex_unlock mut =
- if debug then print_string "Unlocking. ";
+ debug "Unlocking. %!";
Mutex.unlock mut;
- if debug then print_string "Unlocked. \n";;
+ debug "Unlocked. \n%!";;
let actors_id = ref 0
let a_mutex = Mutex.create()
@@ -88,13 +87,13 @@ let receive_scheduler = Queue.create()
let rs_mutex = Mutex.create()
let schedule_receive a f =
- if debug then print_string "In Schedule_receive : ";
+ debug "In Schedule_receive : %!";
mutex_lock rs_mutex;
Queue.add (a, f) receive_scheduler;
mutex_unlock rs_mutex;;
let awake aid =
- if debug then print_string "In Awake : ";
+ debug "In Awake : %!";
let a_env = Hashtbl.find actors aid in
match a_env.actor.actor_location with
| Local lac ->
@@ -109,7 +108,7 @@ let awake aid =
let send a m =
match a.actor_location with
- | Local lac -> begin if debug then print_string "In Send : ";
+ | Local lac -> begin debug "In Send : %!";
mutex_lock lac.mutex;
My_queue.add (mutables_copy m) lac.mailbox;
mutex_unlock lac.mutex;
@@ -123,7 +122,7 @@ exception NotHandled;;
let react f = raise (React f);;
let start a f =
- if debug then Printf.printf "Starting Actor %d \n%!" a.actor_id;
+ debug "Starting Actor %d \n%!" a.actor_id;
try f()
with React g -> schedule_receive a g;;
@@ -143,39 +142,41 @@ let create() =
let reacting a g =
match a.actor_location with
- | Local lac -> begin if debug then print_string "In Reacting : ";
- mutex_lock lac.mutex;
+ | Local lac -> begin debug "In Reacting : %!";
let rec reacting_aux() =
+ mutex_lock lac.mutex;
try
let m = My_queue.take lac.mailbox in
try
- g m; mutex_unlock lac.mutex;
+ mutex_unlock lac.mutex; g m
with
- | React f -> schedule_receive a f ;
+ | React f -> schedule_receive a f;
| NotHandled -> begin reacting_aux();
- My_queue.push m lac.mailbox end
- with My_queue.Empty -> let a_env = Hashtbl.find actors a.actor_id in
- Queue.add g a_env.sleeping;
- in reacting_aux(); mutex_unlock lac.mutex end
+ mutex_lock lac.mutex;
+ My_queue.push m lac.mailbox;
+ mutex_unlock lac.mutex end
+ with My_queue.Empty -> let a_env = Hashtbl.find actors a.actor_id in begin
+ Queue.add g a_env.sleeping; mutex_unlock lac.mutex end
+ in reacting_aux() end
| Remote rac -> failwith "You cannot run a remote actor";;
let rec receive_handler() =
- if debug then print_string "RH : number ";
+ debug "RH : number %!";
let cont = ref true in begin
(try
let (a, f) = Queue.pop receive_scheduler in
- begin (if debug then Printf.printf "%d \n%!" a.actor_id);
+ begin debug "%d \n%!" a.actor_id;
reacting a f; end
with Queue.Empty -> let f a b c = c + Queue.length b.sleeping in
let att = Hashtbl.fold f actors 0 in
- if att = 0 then begin (if debug then print_string "\n Finex.\n%!"); cont := false end
+ if att = 0 then begin debug "\n Finex.\n%!"; cont := false end
else begin Thread.delay 0.01;
- if debug then Printf.printf " En attente : %d \n%!" (Hashtbl.fold f actors 0) end);
+ debug " En attente : %d \n%!" (Hashtbl.fold f actors 0) end);
if (!cont) then receive_handler() end;;
let ping_pong() =
let act1 = create() in
- let act2 = create() in
+ (* let act2 = create() in *)
let rec ping() =
react pig
and pig m =
@@ -193,16 +194,16 @@ let ping_pong() =
if (s = "pong") then begin print_string "pong";
(match l with
| (Actor a) :: (I i) :: q -> Printf.printf " : %d\n%!" i;
- send a ("ping", (Actor act2) :: (I (i + 1)) :: []);
- (* send a ("ping", (Actor act1) :: (I (i + 1)) :: []); *)
+ (* send a ("ping", (Actor act2) :: (I (i + 1)) :: []); *)
+ send a ("ping", (Actor act1) :: (I (i + 1)) :: []);
| _ -> raise NotHandled) ;
pong() end
in begin
start act1 ping;
- start act2 pong;
- (* start act1 pong; *)
- send act1 ("ping", (Actor act2) :: (I 1) :: []);
- (* send act1 ("ping", (Actor act1) :: (I 1) :: []); *)
+ (* start act2 pong; *)
+ start act1 pong;
+ (* send act1 ("ping", (Actor act2) :: (I 1) :: []); *)
+ send act1 ("ping", (Actor act1) :: (I 1) :: []);
receive_handler();
end;;
@@ -235,7 +236,7 @@ let calcul_pi n s =
match l with
| (F r) :: q -> res := (!res) +. r;
if (!compteur = s) then Printf.printf "*** %f ***\n %!" (4. *. !res /. float_of_int n)
- else begin if debug then begin print_string "Recu "; print_int (!compteur) end;
+ else begin debug "Recu %d%!" (!compteur);
incr compteur;
act() end;
| _ -> raise NotHandled
@@ -246,10 +247,22 @@ let calcul_pi n s =
let ac = create() in begin
start ac slave;
send ac ("pi", (Actor main_act) :: (I k) :: (I n) :: (I s) :: []);
- if debug then Printf.printf "Sent pi_request to %d \n %!" k
+ debug "Sent pi_request to %d \n %!" k
end
done;
receive_handler();
Printf.printf "*** Time : %f ***\n %!" (Sys.time() -. t);;
-(* calcul_pi 30000000 100000;; *)
+(* calcul_pi 30000000 1;; *)
+
+let calcul_picpu n =
+ let t = Sys.time() in
+ let res = ref 0.0 in
+ for i = 1 to n do
+ let r = (float_of_int i -. 0.5) /. float_of_int n in
+ res := (!res) +. 1. /. (1. +. r *. r)
+ done;
+ Printf.printf "*** CPU : %f ***\n%!" (4. *. !res /. float_of_int n);
+ Printf.printf "*** Time : %f ***\n %!" (Sys.time() -. t);;
+
+(* calcul_picpu 30000000;; *)

0 comments on commit 13268e5

Please sign in to comment.
Something went wrong with that request. Please try again.