2012-06-27 18:09:30 +02:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Heptagon *)
|
|
|
|
(* *)
|
|
|
|
(* Gwenael Delaval, LIG/INRIA, UJF *)
|
|
|
|
(* Leonard Gerard, Parkas, ENS *)
|
|
|
|
(* Adrien Guatto, Parkas, ENS *)
|
|
|
|
(* Cedric Pasteur, Parkas, ENS *)
|
2012-06-29 01:43:15 +02:00
|
|
|
(* Marc Pouzet, Parkas, ENS *)
|
2012-06-27 18:09:30 +02:00
|
|
|
(* *)
|
|
|
|
(* Copyright 2012 ENS, INRIA, UJF *)
|
|
|
|
(* *)
|
|
|
|
(* This file is part of the Heptagon compiler. *)
|
|
|
|
(* *)
|
|
|
|
(* Heptagon is free software: you can redistribute it and/or modify it *)
|
|
|
|
(* under the terms of the GNU General Public License as published by *)
|
|
|
|
(* the Free Software Foundation, either version 3 of the License, or *)
|
|
|
|
(* (at your option) any later version. *)
|
|
|
|
(* *)
|
|
|
|
(* Heptagon is distributed in the hope that it will be useful, *)
|
|
|
|
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
|
|
|
|
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
|
|
|
|
(* GNU General Public License for more details. *)
|
|
|
|
(* *)
|
|
|
|
(* You should have received a copy of the GNU General Public License *)
|
|
|
|
(* along with Heptagon. If not, see <http://www.gnu.org/licenses/> *)
|
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
(* $Id: simulator.ml 2418 2011-01-13 20:55:13Z delaval $ *)
|
|
|
|
|
|
|
|
(* Graphical simulator *)
|
|
|
|
|
|
|
|
open Compiler_utils
|
|
|
|
open Errors
|
|
|
|
open Modules
|
|
|
|
open Signature
|
|
|
|
open Names
|
|
|
|
open Types
|
2013-08-02 13:58:36 +02:00
|
|
|
open Printf
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
let print_debug s =
|
|
|
|
Printf.printf "%s\n" s;
|
|
|
|
flush stdout
|
|
|
|
|
|
|
|
let autostep = ref None
|
|
|
|
|
|
|
|
let running_thread = ref None
|
|
|
|
let running_period = ref 0.5
|
|
|
|
|
2013-08-02 13:58:36 +02:00
|
|
|
type simtype = Tbool | Tint | Treal | Tother
|
|
|
|
|
|
|
|
let simtype_of_type ty =
|
|
|
|
match Modules.unalias_type ty with
|
|
|
|
| Tid{ qual = Pervasives; name = "int" } -> Tint
|
|
|
|
| Tid{ qual = Pervasives; name = "float" } -> Treal
|
|
|
|
| Tid{ qual = Pervasives; name = "bool" } -> Tbool
|
|
|
|
| _ -> Tother
|
|
|
|
|
|
|
|
|
|
|
|
type output_format = Rif | VCD
|
|
|
|
|
|
|
|
type chrono_viewer = Sim2chro | GtkWave
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
class type input =
|
|
|
|
object
|
|
|
|
method get_input : string
|
|
|
|
method get_random_input : string
|
|
|
|
method set_input : string -> unit
|
|
|
|
method reset : unit
|
|
|
|
end
|
|
|
|
|
|
|
|
class boolean_input (table:GPack.table) n : input =
|
|
|
|
let value = ref false in
|
|
|
|
let click_processed = ref false in
|
|
|
|
let but_true = GButton.toggle_button ~label:"true" ~active:false () in
|
|
|
|
let _ = table#attach ~expand:`BOTH ~left:1 ~right:2 ~top:n but_true#coerce in
|
|
|
|
let but_false = GButton.toggle_button ~label:"false" ~active:true () in
|
|
|
|
let _ = table#attach ~expand:`BOTH ~left:2 ~right:3 ~top:n but_false#coerce in
|
|
|
|
let toggle new_value =
|
|
|
|
value := new_value;
|
|
|
|
click_processed := true;
|
|
|
|
but_false#set_active (not !value);
|
|
|
|
but_true#set_active !value;
|
|
|
|
click_processed := false;
|
|
|
|
in
|
|
|
|
let click button_clicked () =
|
|
|
|
if not !click_processed then
|
|
|
|
begin
|
2011-05-18 09:41:06 +02:00
|
|
|
click_processed := true;
|
|
|
|
value := not !value;
|
|
|
|
begin match button_clicked with
|
|
|
|
| false ->
|
|
|
|
but_true#set_active !value
|
|
|
|
| true ->
|
|
|
|
but_false#set_active (not !value)
|
|
|
|
end;
|
|
|
|
begin match !autostep with
|
|
|
|
| None -> ()
|
|
|
|
| Some f -> f ()
|
|
|
|
end;
|
|
|
|
click_processed := false
|
2011-05-12 10:08:13 +02:00
|
|
|
end
|
|
|
|
in
|
|
|
|
let _ = (but_true#connect#clicked ~callback:(click true)) in
|
|
|
|
let _ = (but_false#connect#clicked ~callback:(click false)) in
|
|
|
|
object
|
2011-05-18 09:41:06 +02:00
|
|
|
method get_input =
|
2011-05-12 10:08:13 +02:00
|
|
|
if !value then "1" else "0"
|
|
|
|
method get_random_input =
|
|
|
|
let v = Random.bool () in
|
|
|
|
toggle v;
|
|
|
|
if v then "1" else "0"
|
|
|
|
method set_input s =
|
|
|
|
let v = match s with
|
|
|
|
| "0" | "f" | "false" -> false
|
|
|
|
| _ -> true in
|
|
|
|
toggle v
|
|
|
|
method reset =
|
|
|
|
toggle false
|
|
|
|
end
|
|
|
|
|
|
|
|
class enum_input mod_name value_list (table:GPack.table) n : input =
|
|
|
|
let mod_name = modul_to_string mod_name in
|
|
|
|
let value = ref ((List.hd value_list).name) in
|
|
|
|
let click_processed = ref false in
|
2011-05-18 09:41:06 +02:00
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
let nb_values = List.length value_list in
|
|
|
|
let buttons_frame = GPack.table ~columns:nb_values ~rows:1 () in
|
2011-05-18 09:41:06 +02:00
|
|
|
let _ = table#attach
|
2011-05-12 10:08:13 +02:00
|
|
|
~expand:`BOTH ~left:1 ~right:3 ~top:n buttons_frame#coerce in
|
2011-05-18 09:41:06 +02:00
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
let rec create_buttons n first = function
|
|
|
|
[] -> []
|
|
|
|
| { name = value } :: value_list ->
|
2011-05-18 09:41:06 +02:00
|
|
|
let but = GButton.toggle_button ~label:value ~active:first () in
|
|
|
|
let _ = buttons_frame#attach
|
|
|
|
~expand:`BOTH ~left:n ~right:(n+1) ~top:0 but#coerce in
|
|
|
|
(value,but) :: (create_buttons (n+1) false value_list) in
|
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
let buttons = create_buttons 0 true value_list in
|
|
|
|
let array_buttons = Array.of_list buttons in
|
|
|
|
|
|
|
|
let active_button = ref (snd (List.hd buttons)) in
|
|
|
|
|
|
|
|
let _ = List.iter
|
|
|
|
(fun (v,b) ->
|
|
|
|
let click () =
|
2011-05-18 09:41:06 +02:00
|
|
|
if not !click_processed then
|
|
|
|
begin
|
|
|
|
click_processed := true;
|
2015-02-27 15:39:39 +01:00
|
|
|
value := v;
|
2011-05-18 09:41:06 +02:00
|
|
|
!active_button#set_active false;
|
|
|
|
b#set_active true;
|
|
|
|
active_button := b;
|
|
|
|
begin match !autostep with
|
|
|
|
| None -> ()
|
|
|
|
| Some f -> f ()
|
|
|
|
end;
|
|
|
|
click_processed := false
|
|
|
|
end in
|
2011-05-12 10:08:13 +02:00
|
|
|
ignore(b#connect#clicked ~callback:click)
|
|
|
|
)
|
|
|
|
buttons in
|
|
|
|
|
|
|
|
object
|
2011-05-18 09:41:06 +02:00
|
|
|
method get_input =
|
2011-05-12 10:08:13 +02:00
|
|
|
!value
|
|
|
|
method get_random_input =
|
|
|
|
let i = Random.int (Array.length array_buttons) in
|
|
|
|
let (v,b) = array_buttons.(i) in
|
|
|
|
click_processed := true;
|
|
|
|
value := mod_name ^ "_" ^ v;
|
|
|
|
!active_button#set_active false;
|
|
|
|
b#set_active true;
|
|
|
|
active_button := b;
|
|
|
|
click_processed := false;
|
|
|
|
!value
|
|
|
|
method set_input v =
|
|
|
|
let b = List.assoc v buttons in
|
|
|
|
click_processed := true;
|
|
|
|
value := mod_name ^ "_" ^ v;
|
|
|
|
!active_button#set_active false;
|
|
|
|
b#set_active true;
|
|
|
|
active_button := b;
|
|
|
|
click_processed := false
|
|
|
|
method reset = ()
|
|
|
|
end
|
|
|
|
|
|
|
|
class entry_input default_value (table:GPack.table) n : input =
|
|
|
|
let entry = GEdit.entry ~text:default_value () in
|
|
|
|
let _ = table#attach ~expand:`BOTH ~left:1 ~right:3 ~top:n entry#coerce in
|
|
|
|
object
|
|
|
|
method get_input =
|
|
|
|
entry#text
|
|
|
|
method get_random_input =
|
|
|
|
entry#text
|
|
|
|
method set_input s =
|
|
|
|
entry#set_text s
|
|
|
|
method reset = ()
|
|
|
|
end
|
|
|
|
|
2011-05-18 09:41:06 +02:00
|
|
|
class scale_input default_value lower upper to_float from_float digits
|
2011-05-12 10:08:13 +02:00
|
|
|
(table:GPack.table) n : input =
|
|
|
|
let adj =
|
|
|
|
GData.adjustment
|
|
|
|
~value:default_value
|
|
|
|
~lower:lower
|
|
|
|
~upper:upper
|
|
|
|
() in
|
2011-05-18 09:41:06 +02:00
|
|
|
let scale =
|
|
|
|
GRange.scale
|
2011-05-12 10:08:13 +02:00
|
|
|
`HORIZONTAL
|
|
|
|
~adjustment:adj
|
|
|
|
~digits:digits
|
|
|
|
~draw_value:true
|
|
|
|
() in
|
|
|
|
let _ = table#attach ~expand:`BOTH ~left:1 ~right:3 ~top:n scale#coerce in
|
|
|
|
object
|
|
|
|
method get_input =
|
|
|
|
from_float adj#value
|
|
|
|
method get_random_input =
|
|
|
|
begin match (Random.int 4) with
|
|
|
|
| 0 -> adj#set_value (max adj#lower (adj#value -. adj#step_increment))
|
|
|
|
| 3 -> adj#set_value (min adj#upper (adj#value +. adj#step_increment))
|
|
|
|
| _ -> ()
|
|
|
|
end;
|
|
|
|
from_float adj#value
|
|
|
|
method set_input v =
|
|
|
|
adj#set_value (to_float v)
|
|
|
|
method reset = ()
|
|
|
|
end
|
2011-05-18 09:41:06 +02:00
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
class type output =
|
|
|
|
object
|
|
|
|
method set_output : string -> unit
|
|
|
|
end
|
|
|
|
|
|
|
|
class label_output (table:GPack.table) n : output =
|
|
|
|
let label = GMisc.label ~text:"" () in
|
|
|
|
let _ = table#attach ~expand:`BOTH ~left:1 ~right:2 ~top:n label#coerce in
|
|
|
|
object
|
2011-05-18 09:41:06 +02:00
|
|
|
method set_output s =
|
2011-05-12 10:08:13 +02:00
|
|
|
label#set_text s
|
|
|
|
end
|
|
|
|
|
|
|
|
let sim2chro_type ty =
|
|
|
|
match ty with
|
2013-08-02 13:58:36 +02:00
|
|
|
| Tint -> "int"
|
|
|
|
| Treal -> "real"
|
|
|
|
| Tbool -> "int"
|
2011-05-12 10:08:13 +02:00
|
|
|
| _ -> "string"
|
|
|
|
|
|
|
|
(* input : 1 label, 1 field or two (bool) or more (enum) buttons *)
|
|
|
|
let create_input v_name v_ty n (table:GPack.table) =
|
|
|
|
let label = GMisc.label ~text:v_name () in
|
|
|
|
table#attach ~expand:`BOTH ~left:0 ~right:1 ~top:n label#coerce;
|
|
|
|
match v_ty with
|
|
|
|
| Tid{ qual = Pervasives; name = "int" } ->
|
2011-05-18 09:41:06 +02:00
|
|
|
new scale_input
|
2015-02-27 15:39:39 +01:00
|
|
|
0. (-60.) 60. float_of_string
|
2013-08-02 13:58:36 +02:00
|
|
|
(fun v ->
|
|
|
|
string_of_int (int_of_float v))
|
|
|
|
0
|
|
|
|
table n
|
2011-05-12 10:08:13 +02:00
|
|
|
| Tid{ qual = Pervasives; name = "float" } ->
|
2015-02-27 15:39:39 +01:00
|
|
|
new scale_input 0. (-100.) 100. float_of_string string_of_float 1 table n
|
2011-05-12 10:08:13 +02:00
|
|
|
| Tid{ qual = Pervasives; name = "bool" } ->
|
|
|
|
new boolean_input table n
|
|
|
|
| Tid(name) ->
|
2016-01-18 17:24:51 +01:00
|
|
|
let rec input name =
|
|
|
|
let _ = check_type name in
|
|
|
|
begin try
|
|
|
|
let ty = find_type name in
|
|
|
|
begin
|
|
|
|
match ty with
|
|
|
|
| Tenum(clist) -> new enum_input name.qual clist table n
|
|
|
|
| Talias(Tid name) -> input name
|
|
|
|
| _ -> new entry_input "" table n
|
|
|
|
end
|
|
|
|
with Not_found ->
|
|
|
|
new entry_input "" table n
|
|
|
|
end in
|
|
|
|
input name
|
2011-05-12 10:08:13 +02:00
|
|
|
| _ -> failwith("Arrays and tuples not yet implemented")
|
|
|
|
|
2013-08-02 13:58:36 +02:00
|
|
|
let create_output v_name _v_ty n (table:GPack.table) =
|
2011-05-12 10:08:13 +02:00
|
|
|
let label = GMisc.label ~text:v_name () in
|
|
|
|
table#attach ~expand:`BOTH ~left:0 ~right:1 ~top:n label#coerce;
|
|
|
|
new label_output table n
|
|
|
|
|
|
|
|
let find_in_path filename =
|
|
|
|
let rec find path =
|
|
|
|
match path with
|
|
|
|
[] -> raise(Cannot_find_file filename)
|
|
|
|
| a::rest ->
|
|
|
|
let b = Filename.concat a filename in
|
|
|
|
if Sys.file_exists b then b else find rest in
|
|
|
|
if Sys.file_exists filename then
|
|
|
|
filename
|
|
|
|
else if not(Filename.is_implicit filename) then
|
|
|
|
raise(Cannot_find_file filename)
|
|
|
|
else
|
|
|
|
try
|
|
|
|
let path = Sys.getenv "PATH" in
|
|
|
|
Printf.printf "PATH = %s\n" path;
|
|
|
|
let path = Str.split (Str.regexp ":") path in
|
|
|
|
find path
|
|
|
|
with
|
|
|
|
Cannot_find_file _ | Not_found ->
|
|
|
|
Printf.printf
|
|
|
|
"Warning: command %s not found in your path \
|
|
|
|
(set $PATH variable).\n\
|
|
|
|
Only a minimal chronogram tool will be provided.\n" filename;
|
|
|
|
raise Not_found
|
|
|
|
|
2011-05-18 09:41:06 +02:00
|
|
|
let usage_msg = "Usage: " ^
|
2013-08-02 13:58:36 +02:00
|
|
|
Sys.executable_name ^ " -mod <Module> -node <node> -exec <exec> [OPTION]...\n" ^
|
|
|
|
" " ^ Sys.executable_name ^ " -sig <file>.epci -node <node> -exec <exec> [OPTION]..."
|
2011-05-12 10:08:13 +02:00
|
|
|
and doc_sig = "<file>.epci\tCompiled interface containing node <node> (for backward compatibility)"
|
|
|
|
and doc_mod = "<Module>\tModule containing node <node>"
|
|
|
|
and doc_node = "<node>\tName of simulated node"
|
|
|
|
and doc_exec = "<exec>\tSimulation executable"
|
2013-08-02 13:58:36 +02:00
|
|
|
and doc_sim2chro = "\tOutput to the sim2chro chronogram viewer tool (by default)"
|
|
|
|
and doc_gtkwave = "\tOutput to the GtkWave chronogram viewer tool"
|
|
|
|
and doc_noviewer = "\tNo chronogram viewer used: output to stdout"
|
|
|
|
and doc_vcd = "\tOutput in VCD (Value Change Dump) format (Rif format by default)"
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
let main () =
|
|
|
|
|
|
|
|
let nb_step = ref 0 in
|
|
|
|
let saves = ref [] in
|
|
|
|
|
|
|
|
let mod_name = ref "" in
|
|
|
|
let node_name = ref "" in
|
|
|
|
let exec_name = ref "" in
|
|
|
|
|
2013-08-02 13:58:36 +02:00
|
|
|
let format = ref Rif in
|
|
|
|
let viewer = ref (Some Sim2chro) in
|
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
let mod_name_of_epci epci_name =
|
|
|
|
if Filename.check_suffix epci_name ".epci" then
|
|
|
|
begin
|
2013-08-02 13:58:36 +02:00
|
|
|
let filename = Filename.chop_suffix epci_name ".epci" in
|
|
|
|
mod_name := String.capitalize(Filename.basename filename)
|
2011-05-12 10:08:13 +02:00
|
|
|
end
|
|
|
|
else
|
|
|
|
raise (Arg.Bad("Invalid compiled interface: " ^ epci_name)) in
|
|
|
|
|
|
|
|
let arg_list =
|
|
|
|
[
|
|
|
|
"-sig",Arg.String mod_name_of_epci,doc_sig; (* Backward compatibility *)
|
|
|
|
"-mod",Arg.Set_string mod_name,doc_mod;
|
|
|
|
"-node",Arg.Set_string node_name,doc_node;
|
2013-08-02 13:58:36 +02:00
|
|
|
"-exec",Arg.Set_string exec_name,doc_exec;
|
|
|
|
"-sim2chro",Arg.Unit (fun () -> viewer := (Some Sim2chro); format := Rif),doc_sim2chro;
|
|
|
|
"-gtkwave",Arg.Unit (fun () -> viewer := (Some GtkWave); format := VCD),doc_gtkwave;
|
|
|
|
"-noviewer",Arg.Unit (fun () -> viewer := None),doc_noviewer;
|
|
|
|
"-vcd",Arg.Unit (fun () -> format := VCD),doc_vcd
|
2011-05-12 10:08:13 +02:00
|
|
|
] in
|
|
|
|
Arg.parse
|
|
|
|
arg_list
|
|
|
|
(fun s -> raise (Arg.Bad ("Invalid argument: " ^ s)))
|
|
|
|
usage_msg;
|
2011-05-18 09:41:06 +02:00
|
|
|
|
2014-03-18 11:01:56 +01:00
|
|
|
if (!mod_name = "") || (!node_name = "") || (!exec_name = "") then
|
|
|
|
begin
|
|
|
|
Arg.usage arg_list usage_msg;
|
|
|
|
raise Error
|
|
|
|
end;
|
2011-05-18 09:41:06 +02:00
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
open_module (Module !mod_name);
|
|
|
|
|
|
|
|
let signature = find_value { qual = (Module !mod_name);
|
2011-05-18 09:41:06 +02:00
|
|
|
name = !node_name } in
|
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
let nb_inputs = List.length signature.node_inputs in
|
|
|
|
let nb_outputs = List.length signature.node_outputs in
|
|
|
|
|
|
|
|
|
|
|
|
ignore (GMain.init ());
|
|
|
|
|
|
|
|
(* main windows *)
|
2013-10-29 16:48:34 +01:00
|
|
|
let win = GWindow.window ~allow_shrink:true ~title:(!node_name ^ " - commands") () in
|
2011-05-12 10:08:13 +02:00
|
|
|
let box = GPack.vbox ~packing:win#add () in
|
2013-10-29 16:48:34 +01:00
|
|
|
let up_part = GPack.paned `VERTICAL ~packing:(box#pack ~expand:true) () in
|
|
|
|
let mid_part = GPack.hbox ~packing:(box#pack ~expand:false) () in
|
|
|
|
let period_part = GPack.hbox ~packing:(box#pack ~expand:false) () in
|
|
|
|
let low_part = GPack.button_box `HORIZONTAL ~packing:(box#pack ~expand:false) () in
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
(* Input frame *)
|
2013-10-29 16:48:34 +01:00
|
|
|
let in_frame = GBin.frame ~label:"Inputs" ~packing:up_part#add1 () in
|
|
|
|
let scroll_in =
|
|
|
|
GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:in_frame#add () in
|
2011-05-12 10:08:13 +02:00
|
|
|
let input_frame = GPack.table ~columns:3 ~rows:nb_inputs
|
2013-10-29 16:48:34 +01:00
|
|
|
~packing:scroll_in#add_with_viewport () in
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
(* Output frame *)
|
2013-10-29 16:48:34 +01:00
|
|
|
let out_frame = GBin.frame ~label:"Outputs" ~packing:up_part#add2 () in
|
|
|
|
let scroll_out =
|
|
|
|
GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:out_frame#add () in
|
2013-08-02 13:58:36 +02:00
|
|
|
(* let output_frame = GPack.table ~row_spacings:0 ~border_width:1 ~columns:2 ~rows:nb_outputs *)
|
2011-05-12 10:08:13 +02:00
|
|
|
(* ~packing:out_frame#add () in *)
|
2011-05-18 09:41:06 +02:00
|
|
|
let output_frame = GPack.table ~columns:2 ~rows:nb_outputs
|
2013-10-29 16:48:34 +01:00
|
|
|
~packing:scroll_out#add_with_viewport () in
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
(* Step label *)
|
|
|
|
let step_label = GMisc.label ~text:"Step: -" ~packing:mid_part#add () in
|
|
|
|
(* Period scale *)
|
2013-08-02 13:58:36 +02:00
|
|
|
let _period_label = GMisc.label ~text:"Period" ~packing:period_part#add () in
|
2011-05-12 10:08:13 +02:00
|
|
|
let running_period_adj =
|
2011-05-18 09:41:06 +02:00
|
|
|
GData.adjustment
|
2011-05-12 10:08:13 +02:00
|
|
|
~value:!running_period
|
|
|
|
~lower:0.001
|
|
|
|
~upper:1.0
|
|
|
|
~step_incr:0.01
|
|
|
|
~page_incr:0.1
|
|
|
|
~page_size:0.1 () in
|
|
|
|
ignore(running_period_adj#connect#value_changed
|
2013-08-02 13:58:36 +02:00
|
|
|
~callback:(fun () -> running_period := running_period_adj#value));
|
|
|
|
let _period_scale =
|
2011-05-12 10:08:13 +02:00
|
|
|
GRange.scale
|
|
|
|
`HORIZONTAL
|
|
|
|
~adjustment:running_period_adj
|
|
|
|
~digits:3
|
|
|
|
~draw_value:true
|
|
|
|
~update_policy:`DISCONTINUOUS
|
|
|
|
~packing:period_part#add
|
|
|
|
() in
|
|
|
|
(* Step, autostep, random, run, quit buttons *)
|
|
|
|
let bstep = GButton.button ~label:"Step" ~packing:low_part#add () in
|
2011-05-18 09:41:06 +02:00
|
|
|
let bastep =
|
2011-05-12 10:08:13 +02:00
|
|
|
GButton.toggle_button ~label:"Autostep" ~packing:low_part#add () in
|
2011-05-18 09:41:06 +02:00
|
|
|
let brun =
|
2011-05-12 10:08:13 +02:00
|
|
|
GButton.toggle_button ~label:"Run" ~packing:low_part#add () in
|
2011-05-18 09:41:06 +02:00
|
|
|
let brandom =
|
2011-05-12 10:08:13 +02:00
|
|
|
GButton.toggle_button ~label:"Random" ~packing:low_part#add () in
|
|
|
|
let bquit = GButton.button ~label:"Quit" ~packing:low_part#add () in
|
|
|
|
|
|
|
|
(* chronogram windows *)
|
|
|
|
let chrono = GWindow.window ~title:(!node_name ^ " - chronogram") () in
|
|
|
|
let chrono_box = GPack.vbox ~packing:chrono#add () in
|
2011-05-18 09:41:06 +02:00
|
|
|
let chrono_chronos =
|
2011-05-12 10:08:13 +02:00
|
|
|
GPack.table ~homogeneous:false ~col_spacings:10
|
|
|
|
~columns:11 ~rows:(nb_inputs+nb_outputs)
|
|
|
|
~packing:chrono_box#add () in
|
|
|
|
let packing_chrono = chrono_chronos#attach ~expand:`BOTH in
|
2011-05-18 09:41:06 +02:00
|
|
|
let chrono_buttons =
|
2011-05-12 10:08:13 +02:00
|
|
|
GPack.button_box `HORIZONTAL ~packing:chrono_box#add () in
|
|
|
|
let blatex = GButton.button ~label:"Export in LaTeX"
|
|
|
|
~packing:chrono_buttons#add () in
|
2013-08-02 13:58:36 +02:00
|
|
|
let btikz = GButton.button ~label:"Export in TikZ"
|
|
|
|
~packing:chrono_buttons#add () in
|
2011-05-18 09:41:06 +02:00
|
|
|
let bgnuplot = GButton.button ~label:"Export for Gnuplot"
|
2011-05-12 10:08:13 +02:00
|
|
|
~packing:chrono_buttons#add () in
|
|
|
|
|
|
|
|
let make_label () = GMisc.label ~text:" " () in
|
|
|
|
|
|
|
|
(* create sim2chro process *)
|
2013-08-02 13:58:36 +02:00
|
|
|
let oc_simview =
|
|
|
|
match !viewer with
|
|
|
|
None -> stdout
|
|
|
|
| Some Sim2chro ->
|
|
|
|
begin
|
|
|
|
try
|
|
|
|
let file = find_in_path "sim2chro" in
|
|
|
|
let oc = Unix.open_process_out (file ^ " -ecran") in
|
|
|
|
oc
|
|
|
|
with
|
|
|
|
Not_found -> stdout
|
|
|
|
end
|
|
|
|
| Some GtkWave ->
|
|
|
|
begin
|
|
|
|
try
|
|
|
|
let _ = find_in_path "gtkwave" in
|
|
|
|
let _ = find_in_path "shmidcat" in
|
|
|
|
Unix.open_process_out ("shmidcat | gtkwave -v -I " ^ !node_name ^ ".sav")
|
|
|
|
with
|
|
|
|
Not_found -> stdout
|
|
|
|
end
|
|
|
|
in
|
2011-05-12 10:08:13 +02:00
|
|
|
|
2013-08-02 13:58:36 +02:00
|
|
|
(* Print output headers *)
|
|
|
|
|
|
|
|
begin
|
|
|
|
match !format with
|
|
|
|
| Rif ->
|
|
|
|
output_string oc_simview ("#program \"" ^ !node_name ^ "\"\n");
|
|
|
|
output_string oc_simview "#@inputs\n"
|
|
|
|
| VCD ->
|
|
|
|
let tm = Unix.localtime (Unix.time ()) in
|
|
|
|
fprintf oc_simview "$date %d/%d/%d %d:%d $end\n"
|
|
|
|
tm.Unix.tm_mday (tm.Unix.tm_mon+1) (tm.Unix.tm_year + 1900) tm.Unix.tm_hour tm.Unix.tm_min;
|
|
|
|
fprintf oc_simview "$version Heptagon simulator 1.0 $end\n";
|
|
|
|
fprintf oc_simview "$timescale 1 ms $end\n";
|
|
|
|
fprintf oc_simview "$scope module top $end\n"
|
|
|
|
end;
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
(* Adding inputs *)
|
2011-05-18 09:41:06 +02:00
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
let inputs,_ =
|
2011-05-18 09:41:06 +02:00
|
|
|
List.fold_left
|
2011-05-12 10:08:13 +02:00
|
|
|
(fun (acc,n) { a_name = name; a_type = ty } ->
|
2013-08-02 13:58:36 +02:00
|
|
|
let name =
|
|
|
|
match name with
|
|
|
|
| None -> "Input " ^ (string_of_int n)
|
|
|
|
| Some name -> name in
|
|
|
|
let input = create_input name ty n input_frame in
|
|
|
|
let _chrono_label =
|
|
|
|
GMisc.label ~text:name ~packing:(packing_chrono ~left:0 ~top:n) () in
|
|
|
|
let chrono_data =
|
|
|
|
Array.init 10
|
|
|
|
(fun i ->
|
|
|
|
let lab = make_label () in
|
|
|
|
packing_chrono ~left:(i+1) ~top:n lab#coerce;
|
|
|
|
lab) in
|
|
|
|
let save = ref [] in
|
|
|
|
let ty = simtype_of_type ty in
|
|
|
|
saves := (name, save)::!saves;
|
|
|
|
begin
|
|
|
|
match !format with
|
|
|
|
| Rif -> fprintf oc_simview "\"%s\":%s\n" name (sim2chro_type ty);
|
|
|
|
| VCD ->
|
|
|
|
let vartype, size =
|
|
|
|
begin match ty with
|
|
|
|
Tbool -> "wire", 1
|
|
|
|
| Tint -> "integer", 32
|
|
|
|
| Treal -> "real", 32
|
|
|
|
| Tother -> "event", 1
|
|
|
|
end in
|
|
|
|
fprintf oc_simview "$var %s %d %s %s $end\n" vartype size name name;
|
|
|
|
end;
|
|
|
|
((name,ty,input,chrono_data,save)::acc),(n+1))
|
2011-05-12 10:08:13 +02:00
|
|
|
([],0)
|
|
|
|
signature.node_inputs in
|
|
|
|
|
|
|
|
let inputs = List.rev inputs in
|
|
|
|
|
2013-08-02 13:58:36 +02:00
|
|
|
begin match !format with
|
|
|
|
| Rif ->
|
|
|
|
output_string oc_simview "@#\n";
|
|
|
|
output_string oc_simview "#@outputs\n";
|
|
|
|
| _ -> ()
|
|
|
|
end;
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
(* Adding outputs *)
|
|
|
|
|
|
|
|
let outputs,_ =
|
|
|
|
List.fold_left
|
|
|
|
(fun (acc,n) { a_name = name; a_type = ty } ->
|
2013-08-02 13:58:36 +02:00
|
|
|
let name =
|
|
|
|
match name with
|
|
|
|
| None -> "Output " ^ (string_of_int n)
|
|
|
|
| Some name -> name in
|
|
|
|
let output = create_output name ty n output_frame in
|
|
|
|
let n = n + nb_inputs in
|
|
|
|
let _chrono_label =
|
|
|
|
GMisc.label ~text:name ~packing:(packing_chrono ~left:0 ~top:n) () in
|
|
|
|
let chrono_data =
|
|
|
|
Array.init 10
|
|
|
|
(fun i ->
|
|
|
|
let lab = make_label () in
|
|
|
|
packing_chrono ~left:(i+1) ~top:n lab#coerce;
|
|
|
|
lab) in
|
|
|
|
let save = ref [] in
|
|
|
|
let ty = simtype_of_type ty in
|
|
|
|
begin
|
|
|
|
match !format with
|
|
|
|
| Rif -> fprintf oc_simview "\"%s\":%s\n" name (sim2chro_type ty);
|
|
|
|
| VCD ->
|
|
|
|
let vartype, size =
|
|
|
|
begin match ty with
|
|
|
|
Tbool -> "wire", 1
|
|
|
|
| Tint -> "integer", 32
|
|
|
|
| Treal -> "real", 32
|
|
|
|
| Tother -> "event", 1
|
|
|
|
end in
|
|
|
|
fprintf oc_simview "$var %s %d %s %s $end\n" vartype size name name;
|
|
|
|
end;
|
|
|
|
saves := (name, save)::!saves;
|
|
|
|
((name,ty,output,chrono_data,save)::acc),(n+1))
|
2011-05-12 10:08:13 +02:00
|
|
|
([],0)
|
|
|
|
signature.node_outputs in
|
|
|
|
|
|
|
|
let outputs = List.rev outputs in
|
|
|
|
|
2013-08-02 13:58:36 +02:00
|
|
|
let all_vars =
|
|
|
|
(List.map (fun (name,ty,_,chrono_data,save) -> (name,ty,chrono_data,save)) inputs) @
|
|
|
|
(List.map (fun (name,ty,_,chrono_data,save) -> (name,ty,chrono_data,save)) outputs) in
|
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
(* create simulating process *)
|
|
|
|
let (ic_sim,oc_sim) = Unix.open_process !exec_name in
|
2011-05-18 09:41:06 +02:00
|
|
|
|
2013-08-02 13:58:36 +02:00
|
|
|
(* Exports of traces *)
|
|
|
|
|
|
|
|
let open_filedlg outf default_filename () =
|
|
|
|
(* File chooser dialog for exports *)
|
|
|
|
let dlg = GWindow.file_chooser_dialog ~action:`SAVE () in
|
|
|
|
dlg#add_select_button_stock `SAVE `SAVE_EVENT;
|
|
|
|
dlg#add_button_stock `CANCEL `CANCEL_EVENT;
|
|
|
|
let callback evt =
|
|
|
|
match evt with
|
|
|
|
| `DELETE_EVENT -> ()
|
|
|
|
| `CANCEL_EVENT -> dlg#misc#hide ()
|
|
|
|
| `SAVE_EVENT ->
|
|
|
|
begin match dlg#filename with
|
|
|
|
None -> ()
|
|
|
|
| Some f -> outf f
|
|
|
|
end;
|
|
|
|
dlg#misc#hide ()
|
|
|
|
in
|
|
|
|
ignore(dlg#connect#response ~callback:callback);
|
|
|
|
ignore(dlg#set_filename default_filename);
|
|
|
|
dlg#show ()
|
|
|
|
in
|
|
|
|
|
|
|
|
let output_latex filename =
|
|
|
|
let oc = open_out filename in
|
2011-05-12 10:08:13 +02:00
|
|
|
output_string oc "\\[\n";
|
|
|
|
output_string oc "\\begin{array}{l|";
|
2013-08-02 13:58:36 +02:00
|
|
|
output_string oc (String.make (List.length !((fun (_,_,_,s) -> s) (List.hd all_vars))) 'c');
|
2011-05-12 10:08:13 +02:00
|
|
|
output_string oc "c}\n";
|
|
|
|
output_string oc "\\hline\n";
|
|
|
|
List.iter
|
2013-08-02 13:58:36 +02:00
|
|
|
(fun (name,_,_,save) ->
|
2011-05-12 10:08:13 +02:00
|
|
|
output_string oc ("\\mbox{\\tt " ^ name ^ "}");
|
|
|
|
List.iter
|
|
|
|
(fun x -> output_string oc (" & " ^ x))
|
|
|
|
(List.rev !save);
|
|
|
|
output_string oc " & ...\\\\ ";
|
|
|
|
output_string oc "\\hline\n")
|
2013-08-02 13:58:36 +02:00
|
|
|
all_vars;
|
2011-05-12 10:08:13 +02:00
|
|
|
output_string oc "\\end{array}\n\\]\n";
|
2013-08-02 13:58:36 +02:00
|
|
|
close_out oc in
|
|
|
|
|
|
|
|
let output_tikz filename =
|
|
|
|
let oc = open_out filename in
|
|
|
|
|
|
|
|
(* printing with grouped repeated values *)
|
|
|
|
(* [n] is the number of occurrence of [List.hd s] directly preceding [s] *)
|
|
|
|
let print_signal print_value s =
|
|
|
|
let rec print n s =
|
|
|
|
match s,n with
|
|
|
|
[],_ -> ()
|
|
|
|
| [x],0 -> print_value oc x
|
|
|
|
| [x],_ -> fprintf oc " %d%a" (n+1) print_value x
|
|
|
|
| x1 :: ((x2 :: _) as l),_ when x1 = x2 -> print (n+1) l
|
|
|
|
| x :: l, 0 -> print_value oc x; print 0 l
|
|
|
|
| x :: l, _ -> fprintf oc " %d%a" (n+1) print_value x; print 0 l
|
|
|
|
in print 0 s
|
|
|
|
in
|
|
|
|
|
|
|
|
output_string oc "\\begin{tikztimingtable}\n";
|
|
|
|
List.iter
|
|
|
|
(fun (name,ty,_,save) ->
|
|
|
|
output_string oc (name ^ " & ");
|
|
|
|
print_signal
|
|
|
|
(match ty with
|
|
|
|
Tbool -> (fun oc x -> output_string oc (if x = "0" then "L" else "H"))
|
|
|
|
| _ -> (fun oc x -> output_string oc ("D{" ^ x ^ "}")))
|
|
|
|
(List.rev !save);
|
|
|
|
output_string oc " \\\\\n")
|
|
|
|
all_vars;
|
|
|
|
output_string oc "\\end{tikztimingtable}\n";
|
|
|
|
close_out oc
|
|
|
|
in
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
let output_gnuplot () =
|
|
|
|
let dt = 1.0 in
|
|
|
|
List.iter
|
2013-08-02 13:58:36 +02:00
|
|
|
(fun (name,_,_,save) ->
|
2011-05-12 10:08:13 +02:00
|
|
|
let oc = open_out (name ^ ".gnuplot") in
|
|
|
|
let t = ref 0.0 in
|
|
|
|
List.iter
|
|
|
|
(fun x ->
|
|
|
|
output_string oc ((string_of_float !t) ^ "\t" ^ x ^ "\n");
|
|
|
|
t := !t +. dt)
|
|
|
|
(List.rev !save);
|
|
|
|
close_out oc)
|
2013-08-02 13:58:36 +02:00
|
|
|
all_vars
|
2011-05-12 10:08:13 +02:00
|
|
|
in
|
|
|
|
|
2013-08-02 13:58:36 +02:00
|
|
|
begin match !format with
|
|
|
|
| Rif -> output_string oc_simview "@#\n";
|
|
|
|
| VCD ->
|
|
|
|
output_string oc_simview "$upscope $end\n";
|
|
|
|
output_string oc_simview "$enddefinitions $end\n";
|
|
|
|
output_string oc_simview "#1\n"
|
|
|
|
end;
|
|
|
|
|
|
|
|
flush oc_simview;
|
2011-05-12 10:08:13 +02:00
|
|
|
|
2013-08-02 13:58:36 +02:00
|
|
|
let step_rif (i,o) =
|
|
|
|
output_string oc_simview ("#step " ^ (string_of_int !nb_step) ^ "\n");
|
2011-05-12 10:08:13 +02:00
|
|
|
let print_value v =
|
2013-08-02 13:58:36 +02:00
|
|
|
output_string oc_simview (v ^ "\t") in
|
2011-05-12 10:08:13 +02:00
|
|
|
List.iter print_value (List.rev i);
|
2013-08-02 13:58:36 +02:00
|
|
|
output_string oc_simview "#outs\t";
|
2011-05-12 10:08:13 +02:00
|
|
|
List.iter print_value (List.rev o);
|
2013-08-02 13:58:36 +02:00
|
|
|
output_string oc_simview "\n";
|
|
|
|
flush oc_simview
|
|
|
|
in
|
|
|
|
|
|
|
|
let step_vcd () =
|
|
|
|
List.iter
|
|
|
|
(fun (name,ty,_,save) ->
|
|
|
|
let print x =
|
|
|
|
begin match ty with
|
|
|
|
| Tbool -> fprintf oc_simview "%s%s\n" x name (* 1/0 value *)
|
|
|
|
| Tint | Treal -> fprintf oc_simview "r%s %s\n" x name (* "real" value *)
|
|
|
|
| Tother -> fprintf oc_simview "x %s\n" name (* "x" -> "unknown" value *)
|
|
|
|
end in
|
|
|
|
match !save with
|
|
|
|
| x1 :: x2 :: _ when x1 <> x2 -> print x1
|
|
|
|
| [x] -> print x
|
|
|
|
| _ -> ()
|
|
|
|
)
|
|
|
|
all_vars;
|
|
|
|
fprintf oc_simview "#%d\n" (!nb_step + 1);
|
|
|
|
flush oc_simview
|
2011-05-12 10:08:13 +02:00
|
|
|
in
|
2011-05-18 09:41:06 +02:00
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
let step () =
|
|
|
|
incr nb_step;
|
|
|
|
(* write inputs to simulating process *)
|
|
|
|
let input_strings =
|
|
|
|
List.fold_left
|
2013-08-02 13:58:36 +02:00
|
|
|
(fun acc (_name,_ty,input,chrono,save) ->
|
|
|
|
let s =
|
|
|
|
if brandom#active
|
|
|
|
then input#get_random_input
|
|
|
|
else input#get_input in
|
|
|
|
input#reset;
|
|
|
|
Printf.fprintf oc_sim "%s\n" s;
|
|
|
|
save := s::!save;
|
|
|
|
if !nb_step <= 10 then
|
|
|
|
ignore
|
|
|
|
(List.fold_right
|
|
|
|
(fun x i ->
|
|
|
|
(chrono.(i))#set_text x ; i+1)
|
|
|
|
!save 0)
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
(chrono.(0))#set_text "...";
|
|
|
|
for i = 1 to 9 do
|
|
|
|
(chrono.(i))#set_text (List.nth !save (9-i))
|
|
|
|
done
|
|
|
|
end;
|
|
|
|
s::acc)
|
|
|
|
[]
|
|
|
|
inputs in
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
flush oc_sim;
|
2011-05-18 09:41:06 +02:00
|
|
|
|
2011-05-12 10:08:13 +02:00
|
|
|
(* read outputs *)
|
|
|
|
let output_strings =
|
2011-05-18 09:41:06 +02:00
|
|
|
List.fold_left
|
2013-08-02 13:58:36 +02:00
|
|
|
(fun acc (_name,_ty,output,chrono,save) ->
|
|
|
|
let s = input_line ic_sim in
|
|
|
|
output#set_output s;
|
|
|
|
save := s::!save;
|
|
|
|
if !nb_step <= 10 then
|
|
|
|
ignore
|
|
|
|
(List.fold_right
|
|
|
|
(fun x i ->
|
|
|
|
(chrono.(i))#set_text x ; i+1)
|
|
|
|
!save 0)
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
(chrono.(0))#set_text "...";
|
|
|
|
for i = 1 to 9 do
|
|
|
|
(chrono.(i))#set_text (List.nth !save (9-i))
|
|
|
|
done
|
|
|
|
end;
|
|
|
|
s::acc)
|
|
|
|
[]
|
|
|
|
outputs in
|
|
|
|
|
|
|
|
begin match !format with
|
|
|
|
| Rif -> step_rif (input_strings,output_strings)
|
|
|
|
| VCD -> step_vcd ()
|
|
|
|
end;
|
2011-05-12 10:08:13 +02:00
|
|
|
|
|
|
|
step_label#set_label ("Step: " ^ (string_of_int !nb_step))
|
|
|
|
in
|
|
|
|
|
|
|
|
let toggle_autostep () =
|
|
|
|
match !autostep with
|
|
|
|
| None -> autostep := Some step
|
2013-08-02 13:58:36 +02:00
|
|
|
| Some _f -> autostep := None
|
2011-05-12 10:08:13 +02:00
|
|
|
in
|
|
|
|
|
|
|
|
let rec run () =
|
|
|
|
step();
|
|
|
|
Thread.delay(!running_period);
|
|
|
|
match !running_thread with
|
|
|
|
| None -> Thread.exit()
|
|
|
|
| Some _ -> run ()
|
|
|
|
in
|
|
|
|
|
|
|
|
let toggle_run () =
|
|
|
|
match !running_thread with
|
2011-05-18 09:41:06 +02:00
|
|
|
| None ->
|
|
|
|
let t = Thread.create run () in
|
|
|
|
running_thread := Some t
|
2013-08-02 13:58:36 +02:00
|
|
|
| Some _t -> running_thread := None
|
2011-05-12 10:08:13 +02:00
|
|
|
in
|
|
|
|
|
|
|
|
let quit() =
|
|
|
|
begin try
|
|
|
|
ignore(Unix.close_process_out oc_sim);
|
2013-08-02 13:58:36 +02:00
|
|
|
ignore(Unix.close_process_out oc_simview)
|
2011-05-12 10:08:13 +02:00
|
|
|
with _ -> ()
|
|
|
|
end;
|
|
|
|
exit 0 in
|
|
|
|
|
2013-08-02 13:58:36 +02:00
|
|
|
ignore (blatex#connect#clicked ~callback:(open_filedlg output_latex (!node_name ^ ".tex")));
|
|
|
|
ignore (btikz#connect#clicked ~callback:(open_filedlg output_tikz (!node_name ^ ".tex")));
|
2011-05-12 10:08:13 +02:00
|
|
|
ignore (bgnuplot#connect#clicked ~callback:output_gnuplot);
|
|
|
|
chrono#show ();
|
|
|
|
ignore (bstep#connect#clicked ~callback:step);
|
|
|
|
ignore (bastep#connect#clicked ~callback:toggle_autostep);
|
|
|
|
ignore (brun#connect#clicked ~callback:toggle_run);
|
|
|
|
ignore (bquit#connect#clicked ~callback:quit);
|
|
|
|
ignore (win#connect#destroy ~callback:quit);
|
|
|
|
win#show ();
|
|
|
|
GtkThread.main () ;;
|
|
|
|
|
|
|
|
try main () with Error -> exit 2;;
|