Vous avez reçu un message "Your GitLab account has been locked ..." ? Pas d'inquiétude : lisez cet article https://docs.gricad-pages.univ-grenoble-alpes.fr/help/unlock/

lustreRun.ml 18.5 KB
Newer Older
1
(* Time-stamp: <modified the 05/04/2019 (at 13:45) by Erwan Jahier> *)
Erwan Jahier's avatar
Erwan Jahier committed
2

3
open RdbgPlugin
4
type vars = (string * Data.t) list
Erwan Jahier's avatar
Erwan Jahier committed
5

6
let debug = ref false
7
let debug_msg msg = if !debug then (output_string stderr ("*** dbg: "^msg) ; flush stderr)
8

9
let output_msg2 msg = output_string stdout msg; flush stdout
10

11
12
13
14
15
(* Which one should I use??? *)
let my_string_of_float = string_of_float
let my_string_of_float = Util.my_string_of_float

let subst_to_string (n,v) = n ^ "=" ^ (Data.val_to_string my_string_of_float v)
16

17
let (step_channel : in_channel -> out_channel -> vars -> vars ->
18
     Data.subst list -> Data.subst list) =
19
  fun ic oc in_vars out_vars sl ->
20
21
      let in_vals_str =
        List.fold_left
22
23
          (fun acc (name, _) ->
             let value =
24
               try List.assoc name sl
25
26
27
28
29
               with Not_found ->
                 Printf.fprintf stdout "*** Don't find %s among: %s\n"
                   name (String.concat ", " (List.map fst sl));
                 flush stdout;
                 assert false
30
             in
31
               acc ^ " "^ (Data.val_to_string my_string_of_float value)
32
33
34
35
          )
          ""
          in_vars
      in
36
      let res =
37
        debug_msg  ("Writing '" ^ in_vals_str ^"' to channel\n");
38
        output_string oc (in_vals_str ^"\n");
39
        flush oc;
40
        RifIO.read ic None out_vars
41
42
43
      in
        res

44
45
46
let nohope str _i =
  Printf.eprintf "save/restore state impossible from %s \n" str;
  flush stderr
47
48
49
50
51
52
53
54
(* wrap it with type transformation  *)
let get_io_from_lustre a b =
  let il, ol = Util.get_io_from_lustre a b in
  let il = List.map (fun (id,t) -> id, Data.type_of_string t) il in
  let ol = List.map (fun (id,t) -> id, Data.type_of_string t) ol in
  il, ol


55
56
 (* XXX Doable with DynLink? Or via Ezdl? *)

57
let (make_ec : string -> RdbgPlugin.t) =
Erwan Jahier's avatar
Erwan Jahier committed
58
  fun ec_file -> 
59
60
61
62
63
64
65
  
  let ec_in, ec_out = get_io_from_lustre ec_file None in
  let (ec_stdin_in,  ec_stdin_out) = Unix.pipe () in
  let (ec_stdout_in, ec_stdout_out) = Unix.pipe () in
  
  let ec_ic = Unix.in_channel_of_descr ec_stdout_in in
  let ec_oc = Unix.out_channel_of_descr ec_stdin_out in
Erwan Jahier's avatar
Erwan Jahier committed
66

67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
  let _ = 
    set_binary_mode_in  ec_ic false;
    set_binary_mode_out ec_oc false
  in
  let pid_lustre = 
    let arg_list = ["ecexe"^(Util.exe ()); "-r"; "-rif"; ec_file] in
    let arg_array = Array.of_list arg_list in
    let prog = List.hd arg_list in
    try 
      if !debug then ( 
	     List.iter (fun x -> output_string stderr (x ^ " ")) arg_list;
	     output_string stderr "\n"; 
        flush stderr
      );
      Unix.create_process prog arg_array 
                          ec_stdin_in ec_stdout_out ec_stdout_out
    with Unix.Unix_error(e,_, prog) -> 
      let msg = Unix.error_message e in
      Printf.eprintf "*** Error when creating process with %s: %s\n" prog msg;
      exit 2
  in
  let _ = Printf.eprintf "Process %d (ecexe) created\n" pid_lustre; flush stderr in
  let kill msg =
    (* Printf.print "EOF" *)
    Unix.close ec_stdin_in;
    Unix.close ec_stdin_out;
    Unix.close ec_stdout_in;
    Unix.close ec_stdout_out;
    (try 
        Printf.eprintf "%s\nKilling process %d\n" msg pid_lustre;
        flush stderr;
        Unix.kill pid_lustre Sys.sigterm 
      with e -> (Printf.printf "Killing of ecexe process failed: %s\n" (Printexc.to_string e) ))
  in
  let step = step_channel ec_ic ec_oc ec_in ec_out in
  let step_dbg sl ctx cont =
103
    let enb = ctx.Event.nb in
104
    let ctx = Event.incr_event_nb ctx in
105
    {  ctx with
106
      Event.nb = enb;
107
108
      Event.step = ctx.Event.step;
      Event.depth = ctx.Event.depth;
109
110
111
112
113
      Event.kind = Event.Exit;
      Event.lang = "lustre";
      Event.name=ec_file;
      Event.inputs = [] ;
      Event.outputs = [];
114
      Event.locals = []; 
115
      Event.sinfo = None;
116
      Event.data = ctx.Event.data;
117
      Event.next = (fun () -> cont (step sl) ctx);
118
      Event.terminate = ctx.Event.terminate;
erwan's avatar
erwan committed
119
      Event.reset = ctx.Event.reset;
120
121
122
123
124
125
    } 
  in 
  {
    id = "";
    inputs = ec_in;
    outputs= ec_out;
126
    reset= (fun () -> RifIO.write ec_oc "#reset\n";  flush ec_oc);
127
    kill= kill;
128
129
    save_state = nohope "ec";
    restore_state = nohope "ec";
130
131
132
133
134
    init_inputs= [];
    init_outputs= [];
    step = step;
    step_dbg = step_dbg
  }
135
136

(* Via une edition de liens dynamique *)
137
let (make_ec_dynlink: string -> string -> string -> RdbgPlugin.t) =
138
  fun node ec_file dl_file -> 
139
    let ec_in, ec_out = get_io_from_lustre ec_file None in
140
141
142
143
144
145
146
147
148
149
150
    let dl = Ezdl.dlopen dl_file in
    let new_ctx_cfunc =  Ezdl.dlsym dl (node^ "_new_ctx") in
    let step_cfunc = Ezdl.dlsym dl (node^ "_step") in

    let null_ptr = Ezdl.Ptr_carg (Ezdl.cptr_of ()) in
(*     let ctx = Ezdl.cargs2cptr new_ctx_cfunc null_ptr in *)
(*     let step = Ezdl.cargs2void step_cfunc (Ezdl.Ptr_carg ctx) in *)

      assert false

(**********************************************************************************)
151
let (make_v6 : string -> string -> RdbgPlugin.t) =
152
153
154
155
156
157
158
  fun lus_file node -> 
    let dir = Filename.dirname lus_file in
      if Util2.lv62ec lus_file node dir then 
        make_ec (node ^ ".ec")
      else
        failwith ("Error when compiling " ^ lus_file ^ " with node " ^ node ^"\n")

159
(**********************************************************************************)
160
let (make_v4 : string -> string -> RdbgPlugin.t) =
161
162
163
164
165
166
167
  fun lus_file node -> 
    let dir = Filename.dirname lus_file in
      if Util2.lv42ec lus_file node dir then 
        make_ec (node ^ ".ec")
      else
        failwith ("Error when compiling " ^ lus_file ^ " with node " ^ node ^"\n")

168
169
170
171
172
(**********************************************************************************)
let rec connect_loop sock addr k =
  try Unix.connect sock addr
  with _ -> 
    if k > 0 
173
174
175
176
177
178
179
180
181
182
    then (
      if !debug then (
        let ni = Unix.getnameinfo addr [] in
          Printf.fprintf stderr "connect %s:%s failed;  try again in a second.\n" 
            ni.Unix.ni_hostname ni.Unix.ni_service; 
          flush stderr
      );
      Unix.sleep 1; 
      connect_loop sock addr (k-1) 
    )
183
184
    else failwith "lustreRun: cannot connect to the socket"

185

186
let (make_socket_do : string -> int -> in_channel * RdbgPlugin.t) =
187
  fun sock_adr port -> 
188
189
190
191
192
    let _ =
      if !debug then (
        Printf.fprintf stderr "Start a connection on %s:%d\n" sock_adr port; 
        flush stderr)
    in
193
194
195
196
197
    let inet_addr = Unix.inet_addr_of_string sock_adr in
    let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM  0 in
    let (sock_in, sock_out) =
      try
        connect_loop sock (Unix.ADDR_INET(inet_addr, port)) 100 ;
198
199
200
        if !debug then (
          Printf.fprintf stderr "Socket %s:%d connected \n" sock_adr port; 
          flush stderr);
201
202
203
        (Unix.in_channel_of_descr sock, Unix.out_channel_of_descr sock)
      with 
          Unix.Unix_error(errcode, funcstr, paramstr) ->
204
            failwith ("LustreRun connect failure: " ^ (Unix.error_message errcode) ^
205
                         "(" ^ funcstr ^ " " ^ paramstr ^")\n")
206
    in
207
    let kill msg =
208
      Printf.printf "Killing the socket process (%s:%i)\n" sock_adr port;
209
210
      print_string ("'"^msg^"'");
      flush stdout;
211
      output_string sock_out msg;
212
      flush sock_out;
213
      let str = input_line sock_in in
214
215
216
217
      (* 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
218
    in
219
    let label = Printf.sprintf "[%s:%i] " sock_adr port in
220
    let vars_in, vars_out = 
221
222
223
      if !debug then (
        Printf.fprintf stderr "\nWait for interface declarations on %s:%i.\n" sock_adr port; 
        flush stderr);
224
      RifIO.read_interface ~label:label sock_in (if !debug then Some stderr else None)
225
    in
226
    let step = step_channel sock_in sock_out vars_in vars_out in
227
    let step_dbg sl ctx cont =
228
      let enb = ctx.Event.nb in
229
      let ctx = Event.incr_event_nb ctx in
230
      {  ctx with
231
232
233
        Event.step = ctx.Event.step;
        Event.data = ctx.Event.data;
        Event.depth = ctx.Event.depth;
234
        Event.nb = enb;
235
236
237
238
239
        Event.kind = Event.Exit;
        Event.lang = "socket";
        Event.name=sock_adr ^ ":" ^ (string_of_int port);
        Event.inputs = [] ;
        Event.outputs = [];
240
        Event.locals = [];
241
        Event.sinfo = None;
242
        Event.next = (fun () -> cont (step sl) ctx);
243
        Event.terminate = ctx.Event.terminate;
erwan's avatar
erwan committed
244
        Event.reset = ctx.Event.reset;
245
246
      } 
    in
247
    let plugin = {
Erwan Jahier's avatar
Erwan Jahier committed
248
      id = "";
249
250
      inputs = vars_in;
      outputs= vars_out;
251
      reset= (fun () -> RifIO.write sock_out "#reset\n";  flush sock_out);
252
253
254
      kill= kill;
      init_inputs= [];
      init_outputs= [];
255
256
      save_state =  nohope "socket";
      restore_state = nohope "socket";
257
258
259
260
261
262
263
264
265
      step = step;
      step_dbg = step_dbg
    }
    in
    if !debug then (
      Printf.fprintf stderr "\nInterface declarations on %s:%i, ok.\n" sock_adr port; 
      flush stderr
    );
    sock_in, plugin 
266
267

(* exported *)
268
let (make_socket : string -> int -> RdbgPlugin.t) =
269
  fun sock_adr port -> 
270
271
    let _, p = make_socket_do sock_adr port in
    p
272
(* exported *)
273
let (make_socket_init : string -> int -> RdbgPlugin.t) =
274
  fun sock_adr port -> 
275
276
277
278
279
280
281
    let sock_in, p = make_socket_do sock_adr port in
    let out_init = RifIO.read sock_in None p.outputs in
    let in_init = RifIO.read sock_in None p.inputs in
    { p with 
      init_inputs= in_init;
      init_outputs= out_init;
    }
282

283
(**********************************************************************************)
284
let (make_ec_exe : string -> RdbgPlugin.t) =
285
286
287
288
289
290
291
292
293
294
295
  fun ec_file -> 
    let exe = (Filename.chop_extension ec_file) ^ (Util.exe()) in
    let _ = if not (Sys.file_exists exe) then (
      Printf.printf "*** Error: Can not find the executable %s\n" exe;
      flush stdout;
      exit 2
    ) else (
      Printf.printf "The executable %s exist\n" exe;
      flush stdout
    )
    in
296
    let ec_in, ec_out = get_io_from_lustre ec_file None in
297
298
299
300
301
    let (ec_stdin_in,  ec_stdin_out) = Unix.pipe () in
    let (ec_stdout_in, ec_stdout_out) = Unix.pipe () in
      
    let ec_ic = Unix.in_channel_of_descr ec_stdout_in in
    let ec_oc = Unix.out_channel_of_descr ec_stdin_out in
302

303
304
305
306
307
308
309
310
311
    let _ = 
      set_binary_mode_in  ec_ic false;
      set_binary_mode_out ec_oc false
    in
    let pid_lustre = 
      let arg_list = [exe] in
      let arg_array = Array.of_list arg_list in
      let prog = List.hd arg_list in
        try 
312
313
314
315
316
          if !debug then ( 
	         List.iter (fun x -> output_string stderr (x ^ " ")) arg_list;
	         output_string stderr "\n"; 
            flush stderr
          );
317
          Unix.create_process prog arg_array 
318
            ec_stdin_in ec_stdout_out ec_stdout_out
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
        with Unix.Unix_error(e,_, prog) -> 
          let msg = Unix.error_message e in
            Printf.eprintf "*** Error when creating process with %s: %s\n" prog msg;
            exit 2
    in
    let _ = Printf.eprintf "Process %d (%s) created\n" pid_lustre exe; flush stderr in
    let kill msg =
      Unix.close ec_stdin_in;
      Unix.close ec_stdin_out;
      Unix.close ec_stdout_in;
      Unix.close ec_stdout_out;
      (try 
         Printf.eprintf "%s\nKilling process %d\n" msg pid_lustre;
         flush stderr;
         Unix.kill pid_lustre Sys.sigterm 
       with e -> (Printf.printf "Killing of %s process failed: %s\n" exe (Printexc.to_string e) ))
    in
    let step = step_channel ec_ic ec_oc ec_in ec_out in
337
    let step_dbg sl ctx cont =
338
      let enb = ctx.Event.nb in
339
      let ctx = Event.incr_event_nb ctx in
340
      {  ctx with
341
342
        Event.step = ctx.Event.step;
        Event.data = ctx.Event.data;
343
        Event.nb = enb;
344
        Event.depth = ctx.Event.depth;
345
346
347
348
349
        Event.kind = Event.Exit;
        Event.lang = "ec";
        Event.name = ec_file;
        Event.inputs = [] ;
        Event.outputs = [];
350
        Event.locals = [];
351
        Event.sinfo = None;
352
        Event.next = (fun () -> cont (step sl) ctx);
353
        Event.terminate = ctx.Event.terminate;
erwan's avatar
erwan committed
354
        Event.reset = ctx.Event.reset;
355
356
      } 
    in
357
     {
Erwan Jahier's avatar
Erwan Jahier committed
358
      id = "";
359
360
      inputs = ec_in;
      outputs= ec_out;
361
      reset= (fun () -> RifIO.write ec_oc "#reset\n";  flush ec_oc);
362
      kill= kill;
363
364
      save_state = nohope "stdin/stdout";
      restore_state = nohope "stdin/stdout";
365
366
367
368
369
      init_inputs= [];
      init_outputs= [];
      step = step;
      step_dbg = step_dbg
    }
370
371
372
373

(**********************************************************************************)

let (make_luciole : string -> vars -> vars -> 
374
      (string -> unit) * (Data.subst list -> Data.subst list)) =
375
  fun dro_file luciole_inputs luciole_outputs -> 
376
    if luciole_outputs <> ["Step",Data.Bool] || luciole_outputs <> [] then (
377
378
379
      Printf.eprintf "Inputs are missing. Try to generate them with luciole\n"; 
      Printf.eprintf "Luciole: generate lurette_luciole.c\n"
    ); 
380
381
    let luciole_outputs = List.map (fun (id,t) -> id, Data.type_to_string t) luciole_outputs in
    let luciole_inputs = List.map (fun (id,t) -> id, Data.type_to_string t) luciole_inputs in
Erwan Jahier's avatar
Erwan Jahier committed
382
    Luciole.gen_stubs "lurette" luciole_outputs luciole_inputs;
383
    Printf.eprintf "Luciole: generate lurette.dro from lurette_luciole.c\n"; 
384
385
386
    flush stderr;
    if Util2.c2dro "lurette_luciole.c" then () else 
      ( 
387
        Printf.eprintf "*** Lurette: Fail to generate lurette.dro for luciole! bye...\n"; 
388
389
390
391
        flush stderr;
        exit 2
      );    

392
    Printf.eprintf "\nluciole: launch simec_trap on lurette.dro\n"; 
393
394
395
396
397
398
    let (luciole_stdin_in,  luciole_stdin_out ) = Unix.pipe () in
    let (luciole_stdout_in, luciole_stdout_out) = Unix.pipe () in

    let luciole_ic = Unix.in_channel_of_descr  luciole_stdout_in in
    let luciole_oc = Unix.out_channel_of_descr luciole_stdin_out in
    let _ = 
399
400
      if Sys.os_type <> "Win32" then Unix.set_nonblock luciole_stdin_out;
      if Sys.os_type <> "Win32" then Unix.set_nonblock luciole_stdout_out;
401
402
403
      set_binary_mode_in  luciole_ic false;
      set_binary_mode_out luciole_oc false;
    in
404
    let prog = "simec_trap" ^ (if Sys.os_type="Win32" then ".bat" else "") in
405
406
407
408
409
410
411
412
    let args = [dro_file; string_of_int (Unix.getpid())] in
    let pid = 
      match Util.my_create_process 
        ~std_in:luciole_stdin_in ~std_out:luciole_stdout_out
        ~wait:false
        prog
        args
      with
413
        | Util.KO -> failwith ("error when calling simec_trap" ^ dro_file);
414
415
        | Util.OK -> assert false
        | Util.PID pid -> 
416
            debug_msg (prog ^ " " ^ dro_file ^ ": ok\n");
417
418
            pid
    in
419
    let kill msg = 
420
421
      close_out luciole_oc;
      close_in luciole_ic;
422
423
424
425
426
      (try 
         Printf.eprintf "%s\nKilling process %d\n" msg pid;
         flush stderr;
         Unix.kill pid Sys.sigterm 
       with e -> (Printf.printf "Killing of luciole process failed: %s\n" (Printexc.to_string e) ))
427
    in
428
    let (step : Data.subst list -> Data.subst list) = 
429
430
431
432
433
434
      fun sl -> 
        (* Sends values to luciole *)
        List.iter
          (fun (n,t) -> 
             let value = try List.assoc n sl with Not_found -> 
               let l = String.concat "," (List.map fst sl) in
435
                 if !debug then 
436
437
438
439
440
                   Printf.fprintf stdout "Reading luciole inputs:  %s not found in: %s ; " n l;
                 match t with
                     (* use fake value as luciole input are only displayed ; 
                        hence its not worth exiting when inputs are missing (at first step)
                     *)
441
                     "bool" -> Data.B(true)
442
443
                   | "int"  -> Data.I(42)
                   | "real" -> Data.F(42.0)
444
445
446
                   | _ -> 
                     Printf.fprintf stdout "*** cannot handle %s type as input of Luciole\n" t;
                     assert false
447
             in
448
449
             let val_str = (Data.val_to_string my_string_of_float value) ^"\n" in
               if !debug then
450
                 Printf.fprintf stdout "write_luciole_inputs: %s = %s\n" n val_str;
451
               output_string luciole_oc val_str)
452
453
454
455
456
          luciole_inputs;
        flush luciole_oc;

        debug_msg "Lurette: Start reading Luciole outputs...\n";
        (* Reads values from luciole *)
457
458
459
460
461
462
        let sl_out =
          List.map 
            (fun (name, vtype) -> 
               let str = 
                 debug_msg ("read_luciole_outputs: reading " ^name ^"\n");
                 let rstr = ref (input_line luciole_ic) in
463
464
465
466
467
                   debug_msg ("XXX: '" ^ !rstr ^ "'\n");
                   if (String.length !rstr >1 && String.sub !rstr 0 2 = "#q") then (
                     debug_msg ("luciole process has terminated \n");
                     failwith "luciole process has terminated"
                   );
468
                   while String.length !rstr = 0 || String.sub !rstr 0 1 = "#" do
469
470
471
472
                     debug_msg ("Skipping " ^ !rstr ^ "...\n");
                     rstr :=  input_line luciole_ic
                   done;
                   !rstr
473
               in
474
475
476
477
478
479
480
481
482
483
                 debug_msg ("read_luciole_outputs:"^ str^"\n");
                 let value = 
                   match vtype with
                     | "bool" -> 
                         if str = "t" then Data.B(true) else if str = "f" then Data.B(false) else (
                           output_msg2 ("read_luciole_outputs:Can not convert the value of "
                                        ^name^" into a bool:'"^str^"'\n");
                           exit 2
                         )
                     | "int" -> (
484
                         try Data.I(Util.my_int_of_string str)
485
                         with e ->  
486
                           output_msg2 ("read_luciole_outputs:Can not convert the value of "^
487
488
                                          name^" into an int:'"^str^"'\n"^
                                          (Printexc.to_string e));
489
490
491
492
                           exit 2
                       )
                     | "real" -> (
                         try Data.F(float_of_string str)
493
                         with e ->  
494
                           output_msg2 ("read_luciole_outputs:Can not convert  the value of "
495
496
                                        ^name^" into a float:'"^str^"'\n"^
                                          (Printexc.to_string e));
497
498
499
500
501
502
503
504
505
                           exit 2)
                     |  _ -> assert false
                 in
                   (name, value)
            )
            luciole_outputs
        in
          debug_msg "Lurette: read_luciole_outputs: done.\n";
          sl_out
506
    in
507
      kill, step
508

509
510
(**********************************************************************************)
let (make_dro : string -> vars * vars * 
511
      (string -> unit) * (Data.subst list -> Data.subst list)) =
512
  fun dro -> 
513
    assert false 
514
515
      (* finish me *)

516
(**********************************************************************************)