Commit 138dbd8f authored by Erwan Jahier's avatar Erwan Jahier
Browse files

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

Add Call events.

Fix the step number for "run" lutin machines.
parent bd7fcae5
......@@ -17,7 +17,6 @@ returns (T,T1, T2, T3 : real) =
between(T, 6.0, 9.0)
fby
loop
run T := draw_temp(Heat_on, pre T)
......
......@@ -13,7 +13,7 @@ show_trace := false;;
profiler true;;
let e = run ();;
let e = nexti e 100;;
let e = goto_s e 100;;
print_string (dump_profile_info());;
......
......@@ -26,7 +26,6 @@ i();;
(* The =Event.t= definition *)
let e = run ();;
......@@ -58,12 +57,13 @@ let e = goto_s e 42;;
(* Conditional breakpoints *)
vb "Heat_on" e;;
(* vb "Heat_on" e;; *)
let heat_on e =
List.mem_assoc "Heat_on" e.data &&
(vb "Heat_on" e);;
let heat_off e =
List.mem_assoc "Heat_on" e.data &&
not (vb "Heat_on" e);;
......@@ -78,7 +78,8 @@ let e = next_cond e heat_on;;
(* gdb like Breakpoints *)
reset_rp();add_rp "env:lutin:ex1.lut:main2" ;set_sim2chro false;set_gnuplot false;show_src:=true;;
reset_rp();add_rp "env:lutin:ex1.lut:main2" ;set_sim2chro false;set_gnuplot false;;
show_src:=true;;
let e = run();;
break "ex1.lut::34" ;;
let e = continue e;;
......@@ -164,4 +165,6 @@ let get_state st =
;;
print_string (get_state e.data);;
exit 0
;;
......@@ -2,7 +2,7 @@ open Event;;
open Ldbg;;
open Ldbg_utils;;
set_sim2chro true;;
set_sim2chro false;;
set_gnuplot false;;
ltop "set_seed 1";;
......
......@@ -310,8 +310,10 @@ echo " You can put the following lines in your .emacs file:"
echo " (setq load-path (cons (expand-file-name \"$LURETTEPATH/utils\") load-path))"
echo " (setq auto-mode-alist (cons '(\"\\\\.luc$\" . lucky-mode) auto-mode-alist))"
echo " (setq auto-mode-alist (cons '(\"\\\\.lut\" . lutin-mode) auto-mode-alist))"
echo " (setq auto-mode-alist (cons '(\"\\\\.rif$\" . rif-mode) auto-mode-alist))"
echo " (autoload 'lucky-mode \"lucky\" \"Major mode for editing Lucky code\" t)"
echo " (autoload 'lutin-mode \"lutin\" \"Major mode for editing Lutin code\" t)"
echo " (autoload 'rif-mode \"rif\" \"Major mode for viewing RIF outputs\" t)"
echo
......
......@@ -5,6 +5,8 @@ type ctx = (* herited debug info *)
ctx_depth:int;
ctx_data: Data.subst list;
ctx_terminate: unit -> unit;
ctx_inputs : string list;
ctx_outputs : string list;
}
......@@ -21,7 +23,7 @@ type node_info = {
lang : string;
name : string;
src : src_info list;
cstr : string; (* XXX poor name! *)
cstr : string; (* The elected contraint *)
inputs : string list;
outputs : string list;
}
......@@ -32,15 +34,22 @@ type kind =
| Noinfo
type port =
| Exit
| Fail (* when an elected constraint is unsatisfiable *)
| Call
| Exit
| Fail
(* type port = *)
(* | Call of string *)
(* | Exit of string * cstr * (unit -> src_info list) *)
(* | Fail of string * cstr * (unit -> src_info list) *)
(* when an elected constraint is unsatisfiable *)
type t = {
nb:int;
step : int;
depth : int;
port : port;
kind : kind;
port : port;
data : Data.subst list;
other : string;
next : unit -> t;
......
......@@ -41,11 +41,13 @@ let (print_cstr : Event.t -> unit) =
let (port2str: Event.port -> string) =
function
Exit -> "exit"
| Exit -> "exit"
| Fail -> "fail"
| Call -> "call"
let print_event (e:t) =
let l = List.map (fun (vn,v) -> vn^"="^Data.val_to_string v) e.data in
let l = List.filter (fun (vn,_) -> String.length vn < 4 || String.sub vn 0 4 <> "pre_") e.data in
let l = List.map (fun (vn,v) -> vn^"="^Data.val_to_string v) l in
let vals = if !show_data then String.concat "," l else "" in
let blanks = String.make e.depth ' ' in
(match e.kind with
......
......@@ -298,6 +298,8 @@ let (start : unit -> Event.t) =
Event.ctx_name = "ltop";
Event.ctx_depth = 1;
Event.ctx_data = edata;
Event.ctx_inputs = [];
Event.ctx_outputs = [];
Event.ctx_terminate = (fun () -> killem_all cov)
}
in
......@@ -439,6 +441,8 @@ let (start : unit -> Event.t) =
Event.ctx_step = 1;
Event.ctx_name = "ltop";
Event.ctx_depth = 1;
Event.ctx_inputs = [];
Event.ctx_outputs = [];
Event.ctx_data = [];
Event.ctx_terminate = (fun () -> killem_all cov_init)
}
......
......@@ -1434,14 +1434,8 @@ let rec (genpath_ldbg : t -> store -> CoTraceExp.t -> Event.ctx -> (behavior ->
if (check_satisfiablity it new_acc) then
br_cont.doit_ldbg (Goto (new_acc, TE_eps)) cont
else
let edata = (Value.OfIdent.content data.curs) in
let edata =
List.map (fun (n,v) -> n, Value.to_data_val v) edata
in
let predata = (Value.OfIdent.content data.pres) in
let predata =
List.map (fun (n,v) -> "pre_" ^ n, Value.to_data_val v) predata
in
let event =
{
Event.step = ctx.Event.ctx_step;
......@@ -1457,11 +1451,11 @@ let rec (genpath_ldbg : t -> store -> CoTraceExp.t -> Event.ctx -> (behavior ->
List.map to_src_info (
if snd si = [] then acc.g_src else (snd si)::acc.g_src);
Event.cstr = CoAlgExp.lus_dumps ae;
Event.inputs = []; (* get it from ctx ? *)
Event.outputs = [];
Event.inputs = ctx.Event.ctx_inputs; (* get it from ctx *)
Event.outputs = ctx.Event.ctx_outputs;
});
Event.other = "";
Event.data = edata @ predata;
Event.data = ctx.Event.ctx_data;
Event.next =
(* n.b. raise Deadlock if impossible *)
(fun () -> failwith "dead code");
......@@ -1837,7 +1831,9 @@ let rec (genpath_ldbg : t -> store -> CoTraceExp.t -> Event.ctx -> (behavior ->
rec_genpath_ldbg ({br with br_ctrl_ldbg=e'; br_data_ldbg = new_data}) cont
in
let ctx = { ctx with
Event.ctx_depth = ctx.Event.ctx_depth+1
Event.ctx_depth = ctx.Event.ctx_depth+1;
Event.ctx_step = -1;
}
in
cont2 (Reactive.DoStep_ldbg(to_reactive_prg_ldbg ctx rid zeexe inits))
......@@ -1946,7 +1942,8 @@ let rec (genpath_ldbg : t -> store -> CoTraceExp.t -> Event.ctx -> (behavior ->
rec_genpath_ldbg ({br with br_ctrl_ldbg=e'; br_data_ldbg = new_data}) cont
in
let ctx = { ctx with
Event.ctx_depth = ctx.Event.ctx_depth+1
Event.ctx_depth = ctx.Event.ctx_depth+1;
Event.ctx_step = -1;
}
in
cont2 (Reactive.DoStep_ldbg (to_reactive_prg_ldbg ctx rid zeexe inits))
......@@ -2069,7 +2066,19 @@ and (to_reactive_prg_ldbg : Event.ctx -> string -> t -> internal_state -> Value.
let addin acc invar inval = Value.OfIdent.add acc (Var.name invar,inval) in
let ins = List.fold_left2 addin Value.OfIdent.empty (in_var_list it) invals in
let data = { curs = ins; pres = pres } in
let edata = (Value.OfIdent.content data.curs) in
let edata = List.map (fun (n,v) -> n, Value.to_data_val v) edata in
let predata = (Value.OfIdent.content data.pres) in
let predata = List.map (fun (n,v) -> "pre_"^n, Value.to_data_val v) predata in
let ctx = { ctx with
Event.ctx_name = rid;
Event.ctx_step = ctx.Event.ctx_step+1;
Event.ctx_data = edata@predata;
Event.ctx_inputs = List.map Var.name (in_var_list it);
Event.ctx_outputs = List.map Var.name (out_var_list it);
}
in
let (cont2: behavior -> Event.t) = fun b ->
match b with
| Raise x -> raise (Exception x)
......@@ -2082,29 +2091,24 @@ and (to_reactive_prg_ldbg : Event.ctx -> string -> t -> internal_state -> Value.
let pres' = make_pre it ins outs locs in
let state' = (ctrl', pres') in
let outvals = List.map (fun x -> Value.OfIdent.get outs (Var.name x)) (out_var_list it) in
let edata =
List.map
(fun x -> Var.name x,
Value.to_data_val (Value.OfIdent.get outs (Var.name x)))
(out_var_list it)
in
let edata = edata @
let edata =
List.map
(fun x -> Var.name x,
Value.to_data_val (Value.OfIdent.get ins (Var.name x)))
(in_var_list it)
in
let edata = edata @
List.map
(fun x -> Var.name x,
Value.to_data_val (Value.OfIdent.get outs (Var.name x)))
(out_var_list it)
in
let edata = edata @
List.map
(fun x -> Var.name x,
Value.to_data_val (Value.OfIdent.get locs (Var.name x)))
(loc_var_list it)
in
let nctx = { ctx with
Event.ctx_step = ctx.Event.ctx_step+1;
Event.ctx_name = rid;
}
in
let enb = Event.incr_nb (); Event.get_nb () in
let event =
{
......@@ -2112,32 +2116,50 @@ and (to_reactive_prg_ldbg : Event.ctx -> string -> t -> internal_state -> Value.
Event.nb = enb;
Event.depth = ctx.Event.ctx_depth;
Event.port = Event.Exit;
Event.kind = (* compute it if necessary only *)
Event.kind =
Event.Node
(fun () -> {
Event.lang = "lutin";
Event.name = rid;
Event.src = List.map to_src_info zeguard.g_src;
Event.cstr = guard_to_string zeguard;
Event.inputs = List.map Var.name (in_var_list it);
Event.outputs = List.map Var.name (out_var_list it);
Event.inputs = ctx.Event.ctx_inputs;
Event.outputs = ctx.Event.ctx_outputs;
});
Event.other = "";
Event.data = edata;
Event.next =
(fun () ->
Event.event_nb := enb ;
cont (Reactive.DoStep_ldbg (to_reactive_prg_ldbg nctx rid it state'))
outvals );
Event.event_nb := enb ;
cont (Reactive.DoStep_ldbg (to_reactive_prg_ldbg ctx rid it state'))
outvals );
Event.terminate = ctx.Event.ctx_terminate;
}
in
event
(* if LtopArg.args.LtopArg.ldbg then event else Event.next event *)
in
genpath_ldbg it data cstate ctx cont2
{
Event.step = ctx.Event.ctx_step;
Event.nb = (Event.incr_nb (); Event.get_nb ());
Event.depth = ctx.Event.ctx_depth;
Event.port = Event.Call;
Event.kind =
Event.Node (fun () -> {
Event.lang = "lutin";
Event.name = rid;
Event.src = [];
Event.cstr = "";
Event.inputs = ctx.Event.ctx_inputs;
Event.outputs = ctx.Event.ctx_outputs;
});
Event.data = edata @ predata;
Event.other = "";
Event.next = (fun () -> genpath_ldbg it data cstate ctx cont2 );
Event.terminate = ctx.Event.ctx_terminate;
}
(***************************************************************************************)
......@@ -2228,9 +2250,16 @@ let (step_ldbg: Event.ctx -> string -> t -> control_state -> data_state ->
Formula_to_bdd.clear_step ();
!Solver.clear_snt ();
in
let datal =
(List.map (fun (n,v) -> n, Value.to_data_val v) (Value.OfIdent.content data.ins)) @
(List.map (fun (n,v) -> "pre_" ^ n, Value.to_data_val v) (Value.OfIdent.content data.mems))
in
let ctx = { ctx with
Event.ctx_depth = 2;
Event.ctx_name = node
Event.ctx_name = node;
Event.ctx_depth = ctx.Event.ctx_depth+1;
Event.ctx_data = datal;
Event.ctx_inputs = List.map Var.name (in_var_list prog);
Event.ctx_outputs = List.map Var.name (out_var_list prog);
}
in
let cont2 = fun bg ->
......@@ -2257,7 +2286,7 @@ let (step_ldbg: Event.ctx -> string -> t -> control_state -> data_state ->
List.map
(fun x ->
Var.name x,
Value.to_data_val (Value.OfIdent.get vals (Var.name x))
Value.to_data_val (Value.OfIdent.get vals (Var.name x))
)
vars
in
......@@ -2275,14 +2304,14 @@ let (step_ldbg: Event.ctx -> string -> t -> control_state -> data_state ->
Event.port = Event.Exit;
Event.kind =
Event.Node (fun () -> {
Event.lang = "lutin";
Event.name = node;
Event.src = List.map to_src_info zeguard.g_src;
Event.cstr = guard_to_string zeguard;
Event.inputs = List.map Var.name (in_var_list prog);
Event.outputs = List.map Var.name (out_var_list prog);
});
Event.data = edata;
Event.lang = "lutin";
Event.name = node;
Event.src = List.map to_src_info zeguard.g_src;
Event.cstr = guard_to_string zeguard;
Event.inputs = ctx.Event.ctx_inputs;
Event.outputs = ctx.Event.ctx_outputs;
});
Event.data = ctx.Event.ctx_data @ edata;
Event.other = "";
Event.next = (fun () -> Event.event_nb := enb ; cont ctrl data);
Event.terminate = ctx.Event.ctx_terminate;
......@@ -2290,15 +2319,36 @@ let (step_ldbg: Event.ctx -> string -> t -> control_state -> data_state ->
)
)
in
(* XXX Tout de meme, cette fonction ressemble beaucoup à to_reactive_prg_ldbg... *)
try
get_behavior_gen_ldbg prog data.ins data.mems ctrl ctx cont2
with
DeadlockE e ->
{ e with
Event.nb = (Event.incr_nb (); Event.get_nb ());
Event.next = (fun () -> raise (Deadlock (Event.get_nb ())));
}
{
Event.step = ctx.Event.ctx_step;
Event.nb = (Event.incr_nb (); Event.get_nb ());
Event.depth = ctx.Event.ctx_depth;
Event.port = Event.Call;
Event.kind =
Event.Node (fun () -> {
Event.lang = "lutin";
Event.name = node;
Event.src = [];
Event.cstr = "";
Event.inputs = ctx.Event.ctx_inputs;
Event.outputs = ctx.Event.ctx_outputs;
});
Event.data = ctx.Event.ctx_data;
Event.other = "";
Event.next = (fun () ->
try
get_behavior_gen_ldbg prog data.ins data.mems ctrl ctx cont2
with
DeadlockE e ->
{ e with
Event.nb = (Event.incr_nb (); Event.get_nb ());
Event.next = (fun () -> raise (Deadlock (Event.get_nb ())));
}
);
Event.terminate = ctx.Event.ctx_terminate;
}
(***************************************************************************************)
(*** DEBUG ***)
......
......@@ -147,7 +147,7 @@ $(LURETTE_RELEASE_NAME).tgz: strip
cp -rf $(LURETTE_PATH)/examples/xlurette/call-luciole /tmp/$(LURETTE_RELEASE_NAME)/examples/xlurette
cp -rf $(LURETTE_PATH)/examples/lutin/xlurette /tmp/$(LURETTE_RELEASE_NAME)/examples/lutin/
\
cp -rf $(LURETTE_PATH)/utils /tmp/$(LURETTE_RELEASE_NAME)/utils
cp -rf $(LURETTE_PATH)/utils /tmp/$(LURETTE_RELEASE_NAME)/
cp $(LURETTE_PATH)/LICENCE /tmp/$(LURETTE_RELEASE_NAME)/
\
cd /tmp && tar cvfz $(LURETTE_RELEASE_NAME).tgz $(LURETTE_RELEASE_NAME)
......
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