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.

source/Lurettetop/Makefile.lurettetop

@@ -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)

source/Lurettetop/cmd.mli

@@ -7,4 +7,4 @@
    - modifies LtopArg.args
    - builds and runs lurette
 *)
-val read : (unit -> string) -> bool
+val read : string -> bool

source/Lurettetop/event.ml

+
+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
+

source/Lurettetop/ldbg.ml

+(* 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")

source/Lurettetop/lurettetop.ml

@@ -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 "" ()
 ;;
+

source/Lurettetop/run.ml

@@ -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)

source/Lurettetop/runDirect.ml

@@ -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 

source/Lurettetop/runDirect.mli

 
-(* 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

source/Makefile

@@ -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 
 

source/Makefile.release

@@ -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)?"

source/common/lustreRun.ml

@@ -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 = 

source/common/lutinRun.mli

@@ -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

source/misc/call-via-socket.ml

@@ -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 *)