Commit 2de4e3ac authored by Erwan Jahier's avatar Erwan Jahier
Browse files

A first step towards a Morphine lutin/lustre debugger for lurette/lutin/lustre.

The idea is to make lurettetop a caml toplevel that launches in
coroutine the whole test execution.

In order to implement that, I broke the inner loop in RunDirect.f
replace by a continuation that will make the coroutine easier.

Next step is to do the same in the lutin step.
parent 3e960d12
......@@ -35,12 +35,14 @@ USE_CAMLP4 = yes
SOURCES = $(LUTIN_SOURCES) \
SOURCES = \
$(LUTIN_SOURCES) \
$(OBJDIR)/ltopArg.ml \
$(OBJDIR)/lutinRun.mli \
$(OBJDIR)/lutinRun.ml \
$(OBJDIR)/ocamlRM.mli \
$(OBJDIR)/ocamlRM.ml \
$(OBJDIR)/event.ml \
$(OBJDIR)/lustreRun.mli \
$(OBJDIR)/lustreRun.ml \
$(OBJDIR)/ocaml.mli \
......@@ -59,6 +61,7 @@ SOURCES = $(LUTIN_SOURCES) \
$(OBJDIR)/run.ml \
$(OBJDIR)/cmd.mli \
$(OBJDIR)/cmd.ml \
$(OBJDIR)/ldbg.ml \
$(OBJDIR)/lurettetop.ml
RESULT = ./lurettetop_exe$(EXE)
......
This diff is collapsed.
......@@ -7,4 +7,4 @@
- modifies LtopArg.args
- builds and runs lurette
*)
val read : (unit -> string) -> bool
val read : string -> bool
type t = {
step : int;
data: Data.subst list;
next: unit -> t;
terminate: unit -> unit;
}
(* ou bien un MapString ?
ou bien une structure avec tout un tas d'autre info ?
devra etre abrait en tout cas
*)
exception End of int
let (next : t -> t) = fun e -> e.next ()
let (terminate : t -> unit) = fun e -> e.terminate ()
let (data : t -> Data.subst list) = fun e -> e.data
(* Opium/morphine like debugger *)
open RunDirect
open Event
let rec (ltop : string -> unit) =
fun cmd ->
let continue = Cmd.read cmd in
if not continue then exit 0
(* a few shortcuts *)
let h() = ltop "h"
let i() = ltop "i"
let stl i = ltop ("stl " ^ (string_of_int i))
let add_rp str = ltop ("add_rp \"" ^ str ^ "\"")
(* XXX finish me! *)
let run = RunDirect.start
let next = Event.next
let data = Event.data
let terminate = Event.terminate
let rec (goto : Event.t -> int -> Event.t) =
fun e i ->
if e.step < i then goto (next e) i else e
let (nexti : Event.t -> int -> Event.t) =
fun e cpt ->
if cpt > 0 then goto (next e) (cpt-1) else e
let rec (next_cond : Event.t -> (Event.t -> bool) -> Event.t) =
fun e p ->
let ne = next e in
if p ne then ne else next_cond ne p
let (get_val_event : Event.t -> unit) =
fun e ->
let nl,vl = List.split e.data in
let nl = List.map (fun n -> String.uncapitalize n) nl in
let vstrl = List.map Data.val_to_string vl in
let str =
"let " ^ (String.concat "," nl) ^
" = " ^ (String.concat "," vstrl) ^ ";;\n"
in
print_string (str)
let (vi:string -> Event.t -> int) =
fun n e ->
match List.assoc n e.data with
| Data.I i -> i
| _ -> failwith (n^" is not an int")
let (vf:string -> Event.t -> float) =
fun n e ->
match List.assoc n e.data with
| Data.F f -> f
| _ -> failwith (n^" is not an float")
let (vb:string -> Event.t -> bool) =
fun n e ->
match List.assoc n e.data with
| Data.B b -> b
| _ -> failwith (n^" is not a bool")
......@@ -24,7 +24,8 @@ let main_read_arg () =
let ic = (open_in lurette_rc) in
try
while true do
ignore (Cmd.read (fun _ -> (input_line ic)))
let str = input_line ic in
ignore (Cmd.read str)
done
with End_of_file ->
close_in ic
......@@ -193,7 +194,8 @@ let rec (main_loop : int -> unit) =
);
flush args.ocr
);
let continue = Cmd.read (fun _ -> (input_line args.icr)) in
let str = input_line args.icr in
let continue = Cmd.read str in
if continue then main_loop (cpt+1)
let lurettetop_quit msg () =
......@@ -247,3 +249,4 @@ let _ =
flush stdout;
lurettetop_quit "" ()
;;
......@@ -5,7 +5,14 @@ open LtopArg
let (f : unit -> int) =
fun () ->
try
if args.direct_mode then RunDirect.f () else
if args.direct_mode then
let e = RunDirect.start () in
let rec loop_cont e =
try loop_cont (Event.next e)
with Event.End i -> i
in
loop_cont e
else
if
let f = Filename.concat args.tmp_dir ("lurette" ^ ExtTools.dot_exe) in
not (Sys.file_exists f)
......
......@@ -84,12 +84,12 @@ let (make_rp_list : reactive_program list ->
fun (str, v) -> str ^ "<-" ^ (Data.val_to_string v)
in
let sl2str sl = String.concat "," (List.map string_of_subst sl) in
(fun sli ->
let slo = step sli in
Printf.eprintf "[%s] step(%s) = (%s) \n"
(reactive_program_to_string rp) (sl2str sli) (sl2str slo);
flush stderr;
slo)
(fun sli ->
let slo = step sli in
Printf.eprintf "[%s] step(%s) = (%s) \n"
(reactive_program_to_string rp) (sl2str sli) (sl2str slo);
flush stderr;
slo)
else
step
in
......@@ -106,7 +106,17 @@ exception OracleError of string
exception SutStop of cov_opt
let gnuplot_time = ref 0.0
let (f : unit -> int) =
type ctx = (* herited debug info *)
{
ctx_step :int;
ctx_data: Data.subst list;
ctx_terminate: unit -> unit;
}
let (start : unit -> Event.t) =
fun () ->
gnuplot_time := 0.0;
(* Get sut info (var names, step func, etc.) *)
......@@ -131,8 +141,8 @@ let (f : unit -> int) =
in
let env_kill msg = List.iter (fun f -> f msg) env_kill_l in
let env_step_sl sl = List.flatten (List.map (fun f -> f sl) env_step_sl_l) in
let env_init_in = List.flatten env_init_in_l in
let env_init_out = List.flatten env_init_out_l in
let _env_init_in = List.flatten env_init_in_l in
let _env_init_out = List.flatten env_init_out_l in
let vars_to_string l =
String.concat "\n" (List.map (fun (vn,vt) -> Printf.sprintf "\t%s:%s" vn vt) l)
......@@ -234,68 +244,108 @@ let (f : unit -> int) =
| OC cov ->
let ll = List.map check_one_oracle oracle_out_vals_l in
let cov =
List.fold_left
(fun cov other_oracle_out_vals ->
Coverage.update_cov other_oracle_out_vals cov) cov ll
List.fold_left
(fun cov other_oracle_out_vals ->
Coverage.update_cov other_oracle_out_vals cov) cov ll
in
cov_ref := Some cov;
OC cov
in
(* The main loop *)
let rec loop cov env_in_vals pre_env_out_vals i =
if i > args.step_nb then cov, 0 else
let update_cov cov =
match cov with
| NO -> ()
| OO -> ()
| OC cov ->
let str = String.concat ", " (List.map reactive_program_to_string args.oracles) in
Coverage.dump str args.output cov
in
(* The main loop *)
let killem_all cov =
env_kill "quit\n";
sut_kill "quit\n";
luciole_kill "quit\n";
oracle_kill "quit\n";
close_out oc;
close_out sim2chro_oc;
if args.display_gnuplot then Util2.gnuplotrif_update (args.verbose>1) args.output;
update_cov cov;
in
let rec loop cov env_in_vals pre_env_out_vals i () =
if i > args.step_nb then (killem_all cov; raise (Event.End 0) )
else
let luciole_outs = luciole_step (env_in_vals@pre_env_out_vals) in
let env_in_vals = List.rev_append luciole_outs env_in_vals in
let env_out_vals = env_step_sl env_in_vals in
let env_out_vals = luciole_outs @ env_out_vals in
let sut_in_vals = filter env_out_vals flat_sut_in in
let sut_out_vals =
try sut_step_sl sut_in_vals
with Rif_base.Bye -> raise (SutStop cov)
in
let oracle_in_vals =
if args.delay_env_outputs
then List.rev_append pre_env_out_vals sut_out_vals
else List.rev_append env_out_vals sut_out_vals
in
let oracle_in_vals = List.rev_append luciole_outs oracle_in_vals in
let oracle_in_vals = filter oracle_in_vals flat_oracle_in in
let oracle_out_vals_l = List.map (fun f -> f oracle_in_vals) oracle_step_sl_l in
let print_val (vn,vv) = Data.val_to_string vv in
Printf.fprintf oc "#step %d\n" i;
if args.delay_env_outputs then (
output_string oc (String.concat " " (List.map print_val (pre_env_out_vals)));
output_string sim2chro_oc (String.concat " " (List.map print_val (pre_env_out_vals)));
)
else (
output_string oc (String.concat " " (List.map print_val env_out_vals));
output_string sim2chro_oc (String.concat " " (List.map print_val env_out_vals));
);
output_string oc (if env_out_vals <> [] then " #outs " else "#outs ");
output_string oc (String.concat " " (List.map print_val sut_out_vals));
output_string oc "\n";
output_string oc "#oracle_outs ";
output_string oc (String.concat " " (List.map print_val (List.flatten oracle_out_vals_l)));
output_string oc "\n";
flush oc;
output_string sim2chro_oc "#outs ";
output_string sim2chro_oc (String.concat " " (List.map print_val sut_out_vals));
output_string sim2chro_oc "\n";
flush sim2chro_oc;
(* { *)
(* step = i; *)
(* data = []; *)
(* next = (fun () -> *)
loop2 cov env_in_vals pre_env_out_vals i luciole_outs env_out_vals
(* ); *)
(* terminate = (fun () -> killem_all cov) *)
(* } *)
if args.display_gnuplot && !gnuplot_time = 0.0
(* gnuplot_oc will be useful to refresh the gnuplot from here
(cf Lutin/main.ml also)
*)
then gnuplot_oc := Util2.gnuplotrif_dyn (args.verbose>1) args.output;
loop (check_oracles oracle_in_vals i oracle_out_l oracle_out_vals_l cov)
sut_out_vals env_out_vals (i+1)
and
loop2 cov env_in_vals pre_env_out_vals i luciole_outs env_out_vals =
let env_out_vals = luciole_outs @ env_out_vals in
let sut_in_vals = filter env_out_vals flat_sut_in in
let sut_out_vals =
try sut_step_sl sut_in_vals
with Rif_base.Bye ->
raise (SutStop cov)
in
let oracle_in_vals =
if args.delay_env_outputs
then List.rev_append pre_env_out_vals sut_out_vals
else List.rev_append env_out_vals sut_out_vals
in
let oracle_in_vals = List.rev_append luciole_outs oracle_in_vals in
let oracle_in_vals = filter oracle_in_vals flat_oracle_in in
let oracle_out_vals_l = List.map (fun f -> f oracle_in_vals) oracle_step_sl_l in
let print_val (vn,vv) = Data.val_to_string vv in
let edata = sut_out_vals@ env_out_vals@(List.flatten oracle_out_vals_l) in
Printf.fprintf oc "#step %d\n" i;
if args.delay_env_outputs then (
output_string oc (String.concat " " (List.map print_val (pre_env_out_vals)));
output_string sim2chro_oc (String.concat " " (List.map print_val (pre_env_out_vals)));
)
else (
output_string oc (String.concat " " (List.map print_val env_out_vals));
output_string sim2chro_oc (String.concat " " (List.map print_val env_out_vals));
);
output_string oc (if env_out_vals <> [] then " #outs " else "#outs ");
output_string oc (String.concat " " (List.map print_val sut_out_vals));
output_string oc "\n";
output_string oc "#oracle_outs ";
output_string oc (String.concat " " (List.map print_val (List.flatten oracle_out_vals_l)));
output_string oc "\n";
flush oc;
output_string sim2chro_oc "#outs ";
output_string sim2chro_oc (String.concat " " (List.map print_val sut_out_vals));
output_string sim2chro_oc "\n";
flush sim2chro_oc;
if args.display_gnuplot && !gnuplot_time = 0.0
(* gnuplot_oc will be useful to refresh the gnuplot from here
(cf Lutin/main.ml also)
*)
then gnuplot_oc := Util2.gnuplotrif_dyn (args.verbose>1) args.output;
{
Event.step = i;
Event.data = edata;
Event.next =
(fun () ->
loop (check_oracles oracle_in_vals i oracle_out_l oracle_out_vals_l cov)
sut_out_vals env_out_vals (i+1) ()
);
Event.terminate = (fun () -> killem_all cov)
}
in
let loc = None in
......@@ -316,51 +366,39 @@ let (f : unit -> int) =
Rif.flush sim2chro_oc;
in
let update_cov cov =
match cov with
| NO -> ()
| OO -> ()
| OC cov ->
let str = String.concat ", " (List.map reactive_program_to_string args.oracles) in
Coverage.dump str args.output cov
in
let msg, res =
try
if res_compat = 0 then
let cov, res = loop cov_init sut_init_out sut_init_in 0 in
update_cov cov;
"quit\n", res
else
"quit\n", res_compat
with
| SutStop cov ->
update_cov cov;
"quit\n", 1
| OracleError str ->
print_string str;
flush stdout;
"quit\n", 2
| Failure str ->
print_string str;
flush stdout;
"quit\n", 2
| e ->
print_string (Printexc.to_string e);
flush stdout;
"quit\n", 2
let (first_event : Event.t) =
let res =
try
if res_compat = 0 then
loop cov_init sut_init_out sut_init_in 0 ()
else
raise(Event.End res_compat)
with
| SutStop cov ->
update_cov cov;
raise(Event.End 1)
| OracleError str ->
print_string str;
flush stdout;
raise(Event.End 2)
| Failure str ->
print_string str;
flush stdout;
raise(Event.End 2)
| e ->
print_string (Printexc.to_string e);
flush stdout;
raise(Event.End 2)
in
res
in
env_kill msg;
sut_kill msg;
luciole_kill msg;
oracle_kill msg;
close_out oc;
close_out sim2chro_oc;
if args.display_gnuplot then Util2.gnuplotrif_update (args.verbose>1) args.output;
res
first_event
let (terminate : unit -> unit) =
(* exported *)
let (clean_terminate : unit -> unit) =
fun () ->
let str = String.concat ", " (List.map reactive_program_to_string args.oracles) in
match !cov_ref with
......
(* An alternative to Run.f that first build a lurette_exe that is forked.
(* XXX An alternative to Run.f that first build a lurette_exe that is forked.
The idea here is to Rely on the LustreRun module (for the Sut and the Oracle)
and LutExe (for lutin).
*)
val start : unit -> Event.t
(* Force clean termination in case of a Ctrl-C *)
val clean_terminate : unit -> unit
val f : unit -> int
val terminate : unit -> unit
......@@ -31,12 +31,11 @@ $(OBJDIR):
CAML_OPT=
# in ocaml 3.12.0 (at least!), libsrt.a is named libcamlstr.a
ifeq ($(shell $(OCAMLC) -version),3.12.0)
ifeq ($(shell $(OCAMLC) -version| cut -f1,2 -d.),3.12)
CAML_OPT=caml
endif
# C'est le meme que le liblurette_nc, mais sans libasmrun car il est
# destin a etre appelle depuis ocaml uniquement.
liblucky_nc.a: liblutin_stubs.o $(OBJDIR)
......@@ -474,6 +473,13 @@ ltop: $(OBJDIR)
$(MAKE) -k ln -f ../Lurettetop/Makefile.lurettetop && \
$(MAKE) -k nc -f ../Lurettetop/Makefile.lurettetop
ltoptop: $(OBJDIR)
cd $(OBJDIR) && \
$(MAKE) -k ln -f ../Lurettetop/Makefile.lurettetop && \
$(MAKE) -k top -f ../Lurettetop/Makefile.lurettetop
ltop_clean: $(OBJDIR)
cd $(OBJDIR) && $(MAKE) -k clean -f ../*/Makefile.lurettetop
......
......@@ -209,7 +209,7 @@ $(LUCKY_RELEASE_NAME).tgz:strip
cp $(LURETTE_PATH)/$(HOSTTYPE)/bin/luc2luciole$(EXE) /tmp/$(LUCKY_RELEASE_NAME)/bin/
cp $(LURETTE_PATH)/$(HOSTTYPE)/bin/lutin$(EXE) /tmp/$(LUCKY_RELEASE_NAME)/bin/
cp $(LURETTE_PATH)/$(HOSTTYPE)/bin/gnuplot-rif$(EXE) /tmp/$(LUCKY_RELEASE_NAME)/bin/
cp $(LURETTE_PATH)/utils/simec_trap /tmp/$(LUCKY_RELEASE_NAME)/bin/
cp $(LURETTE_PATH)/utils/simec_trap /tmp/$(LUCKY_RELEASE_NAME)/bin/
cp `which simec$(EXE)` /tmp/$(LUCKY_RELEASE_NAME)/bin/ || mymsg "cant find simec$(EXE)?"
cp `which luciole` /tmp/$(LUCKY_RELEASE_NAME)/bin/ || mymsg "cant find luciole?"
cp `which sim2chrogtk$(EXE)` /tmp/$(LUCKY_RELEASE_NAME)/bin/ || mymsg "cant find sim2chrogtk$(EXE)?"
......
......@@ -165,7 +165,7 @@ let (make_socket_do : string -> int -> in_channel *
failwith ("LustreRun connect failure: " ^ (Unix.error_message errcode) ^
"(" ^ funcstr ^ " " ^ paramstr ^")\n")
in
let kill msg =
let kill msg =
Printf.printf "Killing the socket process (%s:%i)\n" sock_adr port;
print_string ("'"^msg^"'");
flush stdout;
......@@ -175,7 +175,7 @@ let (make_socket_do : string -> int -> in_channel *
(* make sure that the sut process has read the quit before closing socks *)
print_string (str ^"\n");
flush stdout;
Unix.shutdown sock Unix.SHUTDOWN_ALL
Unix.shutdown sock Unix.SHUTDOWN_ALL
in
let label = Printf.sprintf "[%s:%i] " sock_adr port in
let vars_in, vars_out =
......
......@@ -7,5 +7,7 @@
type vars = (string * string) list
val make_lut: string array ->
vars * vars * (string -> unit) * (Data.subst list -> Data.subst list)
vars * vars * (string -> unit)
* (Data.subst list -> Data.subst list)
(* * (Data.subst list -> Event.ctx -> (Data.subst list -> Event.t) -> Event.t *)
* Data.subst list * Data.subst list
......@@ -113,11 +113,11 @@ let (sock_in, sock_out) =
)
with
Unix.Unix_error(errcode, funcstr, paramstr) ->
output_string log "call-via-socket connect failure: ";
output_string log (Unix.error_message errcode);
output_string log ("(" ^ funcstr ^ " " ^ paramstr ^")\n");
flush log;
exit 2
output_string log "call-via-socket connect failure: ";
output_string log (Unix.error_message errcode);
output_string log ("(" ^ funcstr ^ " " ^ paramstr ^")\n");
flush log;
exit 2
(*****************************************************************************)
(* Forking *)
......
Supports Markdown
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