Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

debug

  • Loading branch information...
commit 1f4b00cc4127d9271ede56c766cfca3ad580cc6f 1 parent c8d9a9b
@SylvainGBR authored
Showing with 38 additions and 31 deletions.
  1. +1 −1  Makefile
  2. +37 −30 actorssg.ml
View
2  Makefile
@@ -1,4 +1,4 @@
-SOURCES = actorssg.ml
+SOURCES = my_queue.ml actorssg.ml
EXE = actorssg
all:
View
67 actorssg.ml
@@ -1,5 +1,9 @@
-let debug = false;;
-
+let debug = true
+(* 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
@@ -25,7 +29,7 @@ type arg =
and message = string * arg list
and local_actor = {
- mailbox : message Queue.t;
+ mailbox : message My_queue.t;
mutex : Mutex.t;
(* handler : (message -> unit);*)
}
@@ -35,7 +39,7 @@ and remote_actor = {
remote_ip : string;
remote_port : int;
}
-
+
and location =
| Local of local_actor
| Remote of remote_actor
@@ -44,7 +48,7 @@ and actor = {
actor_id : int; (* local number of the actor when it was created *)
actor_location : location;
}
-
+
let mutables_copy (s, al) =
let rec mutables_copy_aux_d (str, argt) =
(str, mutables_copy_aux argt)
@@ -64,7 +68,7 @@ let mutables_copy (s, al) =
type actor_env = {actor: actor; sleeping : (message -> unit) Queue.t};;
let actors = Hashtbl.create 1313 (* Should probably be a weak hashtbl *)
-
+
(* let machines = Hashtbl.create 97 *)
let mutex_lock mut =
@@ -107,7 +111,7 @@ let send a m =
match a.actor_location with
| Local lac -> begin if debug then print_string "In Send : ";
mutex_lock lac.mutex;
- Queue.add (mutables_copy m) lac.mailbox;
+ My_queue.add (mutables_copy m) lac.mailbox;
mutex_unlock lac.mutex;
awake a.actor_id end
| Remote o -> ();;
@@ -119,6 +123,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;
try f()
with React g -> schedule_receive a g;;
@@ -130,7 +135,7 @@ let create() =
begin Mutex.unlock a_mutex;
i end in
let id = new_aid() in
- let l_act = {mailbox = Queue.create() ; mutex = Mutex.create()} in
+ let l_act = {mailbox = My_queue.create() ; mutex = Mutex.create()} in
let new_actor = {actor_id = id; actor_location = Local l_act} in
let new_act_env = {actor = new_actor; sleeping = Queue.create()} in
Hashtbl.add actors new_actor.actor_id new_act_env;
@@ -142,31 +147,30 @@ let reacting a g =
mutex_lock lac.mutex;
let rec reacting_aux() =
try
- let m = Queue.pop lac.mailbox in
+ let m = My_queue.take lac.mailbox in
try
- mutex_unlock lac.mutex; g m;
+ g m; mutex_unlock lac.mutex;
with
- | React f -> schedule_receive a f
- | NotHandled -> begin mutex_unlock lac.mutex;
- reacting_aux() end
- with 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
+ | 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
| Remote rac -> failwith "You cannot run a remote actor";;
-
+
let rec receive_handler() =
if debug then print_string "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 (if debug then Printf.printf "%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 (if debug then print_string "\n Finex.\n%!"); cont := false end
else begin Thread.delay 0.01;
- if debug then Printf.printf "\n\n En attente : %d \n\n" (Hashtbl.fold f actors 0) end);
+ if debug then Printf.printf " En attente : %d \n%!" (Hashtbl.fold f actors 0) end);
if (!cont) then receive_handler() end;;
let ping_pong() =
@@ -178,7 +182,7 @@ let ping_pong() =
let (s, l) = m in
if (s = "ping") then begin print_string "ping";
(match l with
- | (Actor a) :: (I i) :: q -> Printf.printf " : %d\n" i;
+ | (Actor a) :: (I i) :: q -> Printf.printf " : %d\n%!" i;
send a ("pong", (Actor act1) :: (I (i + 1)) :: []);
| _ -> raise NotHandled) ;
ping() end in
@@ -188,20 +192,24 @@ let ping_pong() =
let (s, l) = m in
if (s = "pong") then begin print_string "pong";
(match l with
- | (Actor a) :: (I i) :: q -> Printf.printf " : %d\n" i;
+ | (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)) :: []); *)
| _ -> 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) :: []); *)
receive_handler();
end;;
-(* ping_pong();; *)
+ping_pong();;
let calcul_pi n s =
+ let t = Sys.time() in
let main_act = create() in
let slave() =
let slv m =
@@ -226,7 +234,7 @@ let calcul_pi n s =
let (str, l) = m in
match l with
| (F r) :: q -> res := (!res) +. r;
- if (!compteur = s) then Printf.printf "*** %f ***\n" (4. *. !res /. float_of_int n)
+ 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;
incr compteur;
act() end;
@@ -238,11 +246,10 @@ 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
+ if debug then Printf.printf "Sent pi_request to %d \n %!" k
end
done;
- receive_handler();;
-
-calcul_pi 36000000 1500000;;
+ receive_handler();
+ Printf.printf "*** Time : %f ***\n %!" (Sys.time() -. t);;
-let f a b c = c + Queue.length b.sleeping;;
+(* calcul_pi 30000000 100000;; *)
Please sign in to comment.
Something went wrong with that request. Please try again.