[Krobot-commits] [SCM] krobot branch, master, updated. 2fc328b74df14a0b11be0c3964e5afa7b8ae0a06

[Pierre C. <Ba...@us...>]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "krobot".

The branch, master has been updated
       via  2fc328b74df14a0b11be0c3964e5afa7b8ae0a06 (commit)
      from  75f833848ac5b267cfa2a81304f038a28c26b37a (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 2fc328b74df14a0b11be0c3964e5afa7b8ae0a06
Author: chicco <cha...@cr...>
Date:   Sun Apr 15 07:10:58 2012 +0200

    improve can debugger

-----------------------------------------------------------------------

Changes:
diff --git a/info/control2011/src/can/krobot_can_decoder.ml b/info/control2011/src/can/krobot_can_decoder.ml
index 4c82c9e..bf98edc 100644
--- a/info/control2011/src/can/krobot_can_decoder.ml
+++ b/info/control2011/src/can/krobot_can_decoder.ml
@@ -24,14 +24,13 @@ type field =
       endian : endian;
       field_description : string option } with sexp
 
-type desc = field list with sexp
-type description = field list with sexp
-
 type frame_desc =
     { frame_name : string;
       frame_id : int;
       frame_data : field list;
-      frame_description : string option }
+      frame_description : string option } with sexp
+
+type description = frame_desc with sexp
 
 type result_field =
   | R_bit of bool
@@ -42,8 +41,7 @@ type result_field =
 
 type result = ( string * result_field ) list with sexp
 
-type decode_table =
-    (int * kind,desc * string option) Hashtbl.t
+type decode_table = (int,frame_desc) Hashtbl.t
 
 let is_description_correct desc =
   ( List.for_all (fun { display; size } ->
@@ -58,7 +56,7 @@ let is_description_correct desc =
     else true
 
 let check_description desc =
-  if is_description_correct desc
+  if is_description_correct desc.frame_data
   then Some desc
   else None
 
@@ -70,6 +68,13 @@ let split_bitstring (acc,bitstring) field =
        let rest = Bitstring.dropbits field.size bitstring in
        ((value,field)::acc,rest)
 
+let bit n i = ((1 lsl i) land n) lsr i
+let ones n = max_int mod (1 lsl n)
+let resize_signed ~n ~size =
+  if bit n (size - 1) = 1
+  then n lor ((lnot 0) lsl size)
+  else n
+
 let read_field ((str,start,end_),field) =
   let i = Bitstring.extract_int_ee_unsigned field.endian str start end_ field.size in
   match field.display with
@@ -82,7 +87,9 @@ let read_field ((str,start,end_),field) =
         Some (field.name,R_bit b)
       end
     | Int sign ->
-      failwith "handle sign here...";
+      let i = match sign with
+        | Unsigned -> i
+        | Signed -> resize_signed ~n:i ~size:field.size in
       Some (field.name,R_int i)
     | Hex -> Some (field.name,R_hex i)
     | Char -> Some (field.name,R_char (Char.chr i))
@@ -119,15 +126,21 @@ let default_desc =
     field; field; field; field ]
 
 let decode_frame frame table =
-  let desc,name = try Hashtbl.find table (frame.identifier, frame.kind) with
-    | Not_found -> default_desc,None in
+  let desc,name =
+    try
+      let desc = Hashtbl.find table frame.identifier in
+      desc.frame_data, Some desc.frame_name
+    with
+      | Not_found -> default_desc,None in
   decode_frame' frame desc,name
 
-let init_decode_table () =
-  Hashtbl.create 0
+let set_description t desc =
+  Hashtbl.replace t desc.frame_id desc
 
-let set_description t (i,kind) ?name desc =
-  Hashtbl.replace t (i,kind) (desc,name)
+let init_decode_table l : decode_table =
+  let t = Hashtbl.create 0 in
+  List.iter (set_description t) l;
+  t
 
 let result_to_string = function
   | R_bit b -> string_of_bool b
@@ -136,3 +149,22 @@ let result_to_string = function
   | R_float f -> string_of_float f
   | R_char c -> Printf.sprintf "%c" c
 
+
+(* configuration *)
+type cap =
+  | Value
+  | Min
+  | Max
+
+let cap_of_string = function
+  | "min" -> Min
+  | "max" -> Max
+  | "value" -> Value
+  | s -> failwith (Printf.sprintf "unknown option: %s" s)
+
+type opt =
+    | Field of (string * cap list)
+
+type config =
+    { frame : string;
+      options : opt list; }
diff --git a/info/control2011/src/can/krobot_can_decoder.mli b/info/control2011/src/can/krobot_can_decoder.mli
index 426f8f6..b2cfe9e 100644
--- a/info/control2011/src/can/krobot_can_decoder.mli
+++ b/info/control2011/src/can/krobot_can_decoder.mli
@@ -28,9 +28,8 @@ type frame_desc =
     { frame_name : string;
       frame_id : int;
       frame_data : field list;
-      frame_description : string option }
+      frame_description : string option } with sexp
 
-type desc = field list with sexp
 type description with sexp
 
 type result_field =
@@ -44,12 +43,28 @@ type result = ( string * result_field ) list with sexp
 
 type decode_table
 
-val check_description : desc -> description option
+val check_description : frame_desc -> description option
 
 val decode_frame  : Krobot_can.frame -> decode_table -> result * string option
 
-val init_decode_table : unit -> decode_table
+val init_decode_table : frame_desc list -> decode_table
 
-val set_description : decode_table -> (int * Krobot_can.kind) -> ?name:string -> description -> unit
+val set_description : decode_table -> description -> unit
 
 val result_to_string : result_field -> string
+
+(* configuration file *)
+
+type cap =
+  | Value
+  | Min
+  | Max
+
+val cap_of_string : string -> cap
+
+type opt =
+    | Field of (string * cap list)
+
+type config =
+    { frame : string;
+      options : opt list; }
diff --git a/info/control2011/src/can/krobot_can_desc_parser.mly b/info/control2011/src/can/krobot_can_desc_parser.mly
index 322e88f..d2b2e51 100644
--- a/info/control2011/src/can/krobot_can_desc_parser.mly
+++ b/info/control2011/src/can/krobot_can_desc_parser.mly
@@ -9,8 +9,9 @@
 %token LCOLON, LCBRACKET, RCBRACKET, SEMICOLON, DBLQUOTE
 %token EOF
 
-%start file
+%start file config
 %type <Krobot_can_decoder.frame_desc list> file
+%type <Krobot_can_decoder.config list> config
 %%
 
 file :
@@ -55,4 +56,29 @@ endianness :
   | LITTLEENDIAN  { LittleEndian }
 */
 
+config :
+  | config_field EOF { [$1] }
+  | config_field config { $1 :: $2 }
+;
+
+config_field :
+  | IDENT LCBRACKET options RCBRACKET
+    { { frame = $1; options = $3 } }
+
+options :
+  | option { [$1] }
+  | option SEMICOLON { [$1] }
+  | option SEMICOLON options { $1 :: $3 }
+
+option :
+  | IDENT { Field ($1,[]) }
+  | IDENT caps { Field ($1,$2) }
+
+caps :
+  | cap { [$1] }
+  | cap caps { $1 :: $2 }
+
+cap :
+  | IDENT { cap_of_string $1 }
+
 %%
diff --git a/info/control2011/src/tools/krobot_can_display.ml b/info/control2011/src/tools/krobot_can_display.ml
index 5984832..3372904 100644
--- a/info/control2011/src/tools/krobot_can_display.ml
+++ b/info/control2011/src/tools/krobot_can_display.ml
@@ -1,7 +1,7 @@
 open Lwt
 open Krobot_can_decoder
 
-type frame_identifie =
+type frame_identifier =
   | Text of string
   | Num of int
 
@@ -31,6 +31,10 @@ object (self)
 
 end
 
+let type_name type_ = match type_ with
+  | Text t -> t
+  | Num i -> string_of_int i
+
 class packet_list ~packing =
   let box = GPack.vbox ~packing () in
   let hbox = GPack.hbox ~packing:box#add () in
@@ -65,10 +69,8 @@ class packet_list ~packing =
 
 object
 
-  method add type_ id timestamp (content:result) =
-    let type_name = match type_ with
-      | Text t -> t
-      | Num i -> string_of_int i in
+  method add_packet (type_:frame_identifier) id timestamp (content:result) =
+    let type_name = type_name type_ in
     let iter = packet_store#append () in
     packet_store#set ~row:iter ~column:packet_time timestamp;
     packet_store#set ~row:iter ~column:packet_id id;
@@ -84,19 +86,77 @@ object
 
 end
 
+module StringMap = Map.Make(String)
+
+class field_info ~packing field_name caps =
+  let box = GPack.hbox ~packing () in
+  let _ = GMisc.label ~packing:box#add ~text:field_name () in
+  let result_widgets = List.map (fun cap -> cap, GMisc.label ~packing:box#add ()) caps in
+object
+  method set_result result =
+    List.iter (fun (cap, widget) ->
+      match cap with
+        | Value -> widget#set_label (result_to_string result)
+        | Min | Max -> failwith "TODO min/max display") result_widgets
+  method clear () = List.iter (fun (_,widget) -> widget#set_label "") result_widgets
+end
+
+class kind_info ~packing type_ (options:Krobot_can_decoder.opt list) =
+  let box = GPack.hbox ~packing () in
+  let _ = GMisc.label ~packing:box#add ~text:(type_name type_) () in
+  let count_widget = GMisc.label ~packing:box#add ~text:"0" () in
+  let count = ref 0 in
+  let id = ref 0 in
+  let timestamp = ref 0. in
+  let field_widgets = List.fold_left
+    (fun map -> function
+      | Field (name,cap) ->
+        let field_info = new field_info ~packing:box#add name cap in
+        StringMap.add name field_info map)
+    StringMap.empty options in
+object (self)
+  method add_packet p_id p_timestamp (content:result) =
+    id := p_id;
+    timestamp := p_timestamp;
+    count := !count + 1;
+    count_widget#set_label (string_of_int !count);
+    List.iter (fun (name,result) ->
+      try (StringMap.find name field_widgets)#set_result result
+      with
+        | Not_found -> ()) content
+end
+
+class display_box ~packing =
+  let box = GPack.vbox ~packing () in
+  let displayed = Hashtbl.create 0 in
+object
+  method add_packet (type_:frame_identifier) id timestamp (content:result) =
+    try
+      let kind_info = Hashtbl.find displayed type_ in
+      kind_info#add_packet id timestamp content;
+      true
+    with
+      | Not_found -> false
+  method add_kind type_ options =
+    Hashtbl.add displayed type_ (new kind_info ~packing:box#add type_ options)
+  method clear () = Hashtbl.clear displayed
+end
+
 class ui () =
   (* The toplevel window. *)
   let window = GWindow.window ~title:"can debug" ~width:800 ~height:600 () in
   let main_vbox = GPack.vbox ~packing:window#add () in
   let packet_list = new packet_list ~packing:main_vbox#add in
   let packet_store = ref [] in
-  let decode_table = init_decode_table () in
+  let decode_table = init_decode_table [] in
   let packet_count = ref 0 in
+  let display_box = new display_box ~packing:main_vbox#add in
 
 object (self)
   method window = window
   method main_vbox = main_vbox
   method packet_list = packet_list
+  method display_box = display_box
 
   method display_frame id timestamp frame =
     let result,name = decode_frame frame decode_table in
@@ -104,7 +164,8 @@ object (self)
       | None -> Num frame.Krobot_can.identifier
       | Some n -> Text n
     in
-    self#packet_list#add ident id timestamp result
+    if not (display_box#add_packet ident id timestamp result)
+    then self#packet_list#add_packet ident id timestamp result
 
   method add_packet (timestamp:float) frame =
     let id = !packet_count in
@@ -119,9 +180,12 @@ object (self)
 
   method refresh () =
     packet_list#clear ();
+    display_box#clear ();
     List.iter (fun (id,timestamp,frame) -> self#display_frame id timestamp frame)
       (List.rev !packet_store)
 
+  method decode_table = decode_table
+
   initializer
     ignore (window#connect#destroy quit);
 
@@ -129,13 +193,56 @@ end
 
 let decode_table = ref None
 let iface = ref None
+let config_file = ref None
 
 let parse_arg () =
   let desc =
-    [ "-c", Arg.String (fun s -> decode_table := Some s), "file containing the configuration";
+    [ "-p", Arg.String (fun s -> decode_table := Some s), "file containing the protocol";
+      "-c", Arg.String (fun s -> config_file := Some s), "file containing the configuration";
       "-i", Arg.String (fun s -> iface := Some s), "can interface";] in
   Arg.parse desc (function "" -> () | _ -> Arg.usage desc ""; exit 2) ""
 
+let report_error f s e lexbuf =
+  let open Lexing in
+      let p1 = lexeme_start_p lexbuf in
+      let p2 = lexeme_end_p lexbuf in
+      let exn = Printexc.to_string e in
+      let off1 = p1.pos_cnum - p1.pos_bol in
+      let off2 = p2.pos_cnum - p1.pos_bol in
+      Printf.eprintf "File \"%s\", line %i, characters %i-%i:\nError: %s %s\n"
+	f p1.pos_lnum off1 off2
+	s exn;
+      exit 1
+
+let load_frames_desc f =
+  let channel = open_in f in
+  let lexbuf = Lexing.from_channel channel in
+  try
+    let r =
+      Krobot_can_desc_parser.file
+        Krobot_can_desc_lexer.token
+        lexbuf in
+    close_in channel;
+    r
+  with
+    | e -> report_error f "while parsing frame descriptions" e lexbuf
+
+let load_conf f =
+  match f with
+    | None -> []
+    | Some f ->
+      let channel = open_in f in
+      let lexbuf = Lexing.from_channel channel in
+      try
+        let r =
+          Krobot_can_desc_parser.config
+            Krobot_can_desc_lexer.token
+            lexbuf in
+        close_in channel;
+        r
+      with
+      | e -> report_error f "while parsing configuration" e lexbuf
+
 let loop ui bus =
   let rec aux () =
     lwt (timestamp, frame) = Krobot_can_bus.recv bus in
@@ -149,6 +256,17 @@ let init iface =
   ignore (GMain.init ~setlocale:false ());
   Lwt_glib.install ();
   let ui = new ui () in
+  begin match !decode_table with
+    | None -> ()
+    | Some f ->
+      let l = load_frames_desc f in
+      List.iter (fun d ->
+        match Krobot_can_decoder.check_description d with
+          | None -> ()
+          | Some d -> Krobot_can_decoder.set_description ui#decode_table d) l
+  end;
+  let config = load_conf !config_file in
+  List.iter (fun c -> ui#display_box#add_kind (Text c.frame) c.options) config;
   ui#window#show ();
   pick
     [waiter;


hooks/post-receive
-- 
krobot