Commit bbc64838 authored by erwan's avatar erwan
Browse files

Fix rdbgui4sasa when used with salut

parent b20552fc
(* Time-stamp: <modified the 11/06/2021 (at 15:24) by Erwan Jahier> *)
(* Time-stamp: <modified the 15/06/2021 (at 09:21) by Erwan Jahier> *)
#thread
#require "lablgtk3"
......@@ -13,7 +13,6 @@ open Data
@return liste de tuples (nom, etat, activable)
*)
let rdbg_nodes_info e: (string * string * bool) list =
(* récupère une liste qui dit si chaque état de chaque noeud est activable/pas activable *)
let enabled =
List.filter (fun (n,v) -> String.length n > 5 && String.sub n 0 5 = "Enab_") e.data
in
......@@ -53,7 +52,8 @@ let rdbg_nodes_enabled e =
in
last::res
type daemon_kind = Distributed | Synchronous | Central | LocCentral | ManualCentral | Manual
type daemon_kind =
Distributed | Synchronous | Central | LocCentral | ManualCentral | Manual
let daemon_kind = ref ManualCentral
let refresh_fun_tbl = Hashtbl.create 1
......@@ -80,10 +80,13 @@ let (fake_val_of_type : Data.t -> Data.v) = function
(**********************************************************************************)
(* Write with colors *)
let create_tags (buffer:GText.buffer) =
ignore (buffer#create_tag ~name:"blue_foreground" [`FAMILY "monospace"; `FOREGROUND "blue"]);
ignore (buffer#create_tag ~name:"black_foreground" [`FAMILY "monospace"; `FOREGROUND "black"]);
ignore (buffer#create_tag ~name:"red_foreground" [`FAMILY "monospace"; `FOREGROUND "red"]);
ignore (buffer#create_tag ~name:"green_foreground" [`FAMILY "monospace"; `FOREGROUND "green"]);
let mktags n c =
ignore (buffer#create_tag ~name:n [`FAMILY "monospace";`FOREGROUND c])
in
mktags "blue_foreground" "blue";
mktags "black_foreground" "black";
mktags "red_foreground" "red";
mktags "green_foreground" "green";
ignore (buffer#create_tag ~name:"red_background" [`BACKGROUND "red"]);
()
......@@ -190,11 +193,15 @@ let init_rdbg_hook () =
let set_tooltip b = b#misc#set_tooltip_text
let start () =
(* création du rdbg_mv_hook et de tout ce qu'il faut autour *)
if !custom_mode_ref then init_rdbg_hook ();
if args.salut_mode then
(* In this mode, the hook plays first to provide fake values to
sasa but the hook does not need input at this first step *)
e:=goto_hook_exit !e;
if !custom_mode_ref then e := goto_hook_call !e;
e:=next_cond_gen !e (fun e -> e.name="mv_hook" && e.kind=Exit) (fun e -> e.next());
if !custom_mode_ref then
e:=next_cond_gen !e (fun e -> e.name="mv_hook" && e.kind=Call) (fun e -> e.next());
redos := [!e.nb];
ckpt_list := [!e];
round_reset !e.nb;
......@@ -212,8 +219,6 @@ let restart p _ =
let custom_daemon p gtext vbox step_button back_step_button round_button
legitimate_button undo_button =
(* création du rdbg_mv_hook et de tout ce qu'il faut autour *)
init_rdbg_hook ();
let daemon_box = GPack.hbox ~packing:vbox#add () ~homogeneous:true ~height:15 in
let dk_dd = GButton.radio_button ~active:(!daemon_kind=Distributed)
......@@ -234,6 +239,8 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
set_tooltip dk_manual (Printf.sprintf "Set the manual mode");
set_tooltip dk_manual_central (Printf.sprintf "Set the manual central mode");
start ();
blue_add gtext#buffer (str_of_sasa_event false !e);
d();
let nodes_enabled = rdbg_nodes_enabled !e in
......@@ -363,10 +370,14 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
let counter_lbl = GMisc.label ~packing:counter_container#pack () in
let incB = GButton.button ~label:"+" ~packing:incr_container#add () in
let adj = GData.adjustment ~lower:0. ~upper:100. ~step_incr:1. ~page_incr:10. () in
ignore (decB#connect#clicked ~callback:(fun () -> adj#set_value (float(counter#get-1))));
ignore (incB#connect#clicked ~callback:(fun () -> adj#set_value (float(counter#get+1))));
ignore (adj#connect#value_changed ~callback:(fun () -> counter#set (truncate adj#value)));
ignore (counter#connect#changed ~callback:(fun n -> counter_lbl#set_text (string_of_int n)));
ignore (decB#connect#clicked
~callback:(fun () -> adj#set_value (float(counter#get-1))));
ignore (incB#connect#clicked
~callback:(fun () -> adj#set_value (float(counter#get+1))));
ignore (adj#connect#value_changed
~callback:(fun () -> counter#set (truncate adj#value)));
ignore (counter#connect#changed
~callback:(fun n -> counter_lbl#set_text (string_of_int n)));
counter#set 1;
set_tooltip counter_container (Printf.sprintf "Set the priority of %s" name);
Hashtbl.add counter_map name counter
......@@ -384,7 +395,7 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
hide undo_button;
(match !oracle_button_ref with Some b -> hide b | None -> ());
hide round_button; hide pushbox_grid; hide counter_grid;
let checkbox = Hashtbl.find checkbox_map node in
let checkbox = try Hashtbl.find checkbox_map node with Not_found -> assert false in
if enabled then
show checkbox
else (
......@@ -400,7 +411,7 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
hide step_button;
hide round_button; hide checkbox_grid; hide counter_grid;
show pushbox_grid;
let pushbox = Hashtbl.find pushbox_map node in
let pushbox = try Hashtbl.find pushbox_map node with Not_found -> assert false in
if enabled then show pushbox else hide pushbox;
pushbox#set_sensitive enabled
......@@ -451,7 +462,7 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
let rec get_higher_priority nl =
let prio n =
let counter = Hashtbl.find counter_map n in
let counter = try Hashtbl.find counter_map n with Not_found -> assert false in
counter#get
in
let rec aux p acc = function
......@@ -533,7 +544,6 @@ let ic_stdout = stdin
open GButton
(* GTK3 *)
let main () =
start ();
let _locale = GtkMain.Main.init () in
let _thread = GtkThread.start () in
let window = GWindow.window
......@@ -616,6 +626,7 @@ let main () =
else
(fun _ -> ())
in
let a_gui_step e =
(* set the daemongui_tbl and step to the next event where the user
is asked to choose whom to activate *)
......@@ -623,7 +634,7 @@ let main () =
set_daemongui_tbl e;
let e = goto_hook_exit e in
let e = goto_hook_call e in
if not args.salut_mode && is_silent e then
if not args.salut_mode && is_silent ~dflt:false e then
(* go to Ltop so that the round number can be updated *)
next_cond e (fun e -> e.kind = Ltop)
else
......@@ -644,7 +655,7 @@ let main () =
next_round_gui_loop !round_st_ref.cpt ;
if
!custom_mode_ref && args.salut_mode && !e.name<>"mv_hook"
&& !e.kind<>Call && not (is_silent !e)
&& !e.kind<>Call && not (is_silent ~dflt:false !e)
then
e:= goto_hook_call !e
)
......
......@@ -10,10 +10,12 @@ open Sasacore.Topology;;
let is_silent e =
let is_silent ?(dflt=true) e =
match List.assoc_opt "silent" e.data with
| Some B b -> b
| _ -> failwith "The silent value is not available in this event"
| _ ->
Printf.printf "The silent value is not available at event %d\n%!" e.nb;
dflt
let is_legitimate e =
match List.assoc_opt "legitimate" e.data with
......@@ -84,7 +86,7 @@ let (round : RdbgEvent.t -> bool) =
set_round_st_mask cmask;
round
| None ->
if !round_st_ref.mask = [] && is_silent e then false else
if !round_st_ref.mask = [] && (e.data=[] || is_silent e) then false else
let round =
if not
( (* we check if a round occurs when activated processes are available *)
......
......@@ -5,7 +5,9 @@ let rdbg_cmd =
let cmd = List.tl (List.map quote (Array.to_list Sys.argv)) in
let str = String.concat " " cmd in
let salut_mode = not (Str.string_match (Str.regexp ".*sasa .*\\.dot") str 0) in
let str = Str.replace_first (Str.regexp "sasa ") "sasa -custd -replay " str in
let str = if salut_mode then str else
Str.replace_first (Str.regexp "sasa ") "sasa -custd -replay " str
in
let sasa_opt = if salut_mode then "--salut" else "--sasa" in
String.concat " " ("rdbg"::sasa_opt::str::[])
......@@ -25,4 +27,6 @@ let _ =
let n = Array.length Sys.argv in
welcome ();
if n = 1 && Mypervasives.ls "rdbg-session" "ml" = [] then exit 0;
Sys.command (rdbg_cmd ^ gui)
let cmd = rdbg_cmd ^ gui in
Printf.printf "%s\n%!" cmd;
Sys.command cmd
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment