factorize most of the modules tools

Makefile.ac

@@ -53,7 +53,6 @@ TUNING_H=$(AC_GENERATED)/tuning.h
 SUPERVISION=./paparazzi
 MAKE=make PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME)
 MODULES_H=$(AC_GENERATED)/modules.h
-MODULES_DIR=$(PAPARAZZI_HOME)/conf/modules/
 AIRCRAFT_MD5=$(AIRCRAFT_CONF_DIR)/aircraft.md5
 
 # "make Q=''" to get full echo
@@ -132,7 +131,7 @@ $(TUNING_H) : $(SETTINGS_XMLS) $(CONF_XML) $(TOOLS)/gen_tuning.out
 $(MODULES_H) : $(CONF)/$(AIRFRAME_XML) $(TOOLS)/gen_modules.out $(CONF)/modules/*.xml
 	$(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED)
 	@echo BUILD $@
-	$(Q)$(TOOLS)/gen_modules.out $(MODULES_DIR) $(SETTINGS_MODULES) $< > $@
+	$(Q)$(TOOLS)/gen_modules.out $(SETTINGS_MODULES) $< > $@
 	$(Q)chmod a+r $@
 
 $(SETTINGS_MODULES) : $(MODULES_H)

sw/tools/Makefile

@@ -30,7 +30,7 @@ OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring)
 OCAMLLEX=ocamllex
 OCAMLYACC=ocamlyacc
 
-all: gen_aircraft.out gen_airframe.out gen_messages2.out gen_messages.out gen_ubx.out gen_flight_plan.out gen_radio.out gen_periodic.out gen_settings.out gen_tuning.out gen_xsens.out gen_modules.out find_free_msg_id.out
+all: gen_common.cmo gen_aircraft.out gen_airframe.out gen_messages2.out gen_messages.out gen_ubx.out gen_flight_plan.out gen_radio.out gen_periodic.out gen_settings.out gen_tuning.out gen_xsens.out gen_modules.out find_free_msg_id.out
 
 FP_CMO = fp_proc.cmo gen_flight_plan.cmo
 ABS_FP = $(FP_CMO:%=$$PAPARAZZI_SRC/sw/tools/%)
@@ -46,7 +46,7 @@ gen_flight_plan.cmo : fp_proc.cmi
 
 %.out : %.ml Makefile
 	@echo OC $<
-	$(Q)$(OCAMLC) $(INCLUDES) -o $@ unix.cma str.cma ivy-ocaml.cma xml-light.cma lib-pprz.cma $<
+	$(Q)$(OCAMLC) $(INCLUDES) -o $@ unix.cma str.cma ivy-ocaml.cma xml-light.cma lib-pprz.cma gen_common.cmo $<
 	@cat ../../pprz_src_test.sh > $@
 	@echo '$(OCAML) $(shell ocamlfind query -r -i-format xml-light) $(OCAMLNETINCLUDES) -I $$PAPARAZZI_SRC/sw/lib/ocaml unix.cma str.cma ivy-ocaml.cma xml-light.cma $(OCAMLNETCMA) lib-pprz.cma $$PAPARAZZI_BIN/$< $$*' >> $@
 	@chmod a+x $@

sw/tools/gen_aircraft.ml

@@ -26,12 +26,12 @@
 
 open Printf
 module U = Unix
+module GC = Gen_common
 
 let (//) = Filename.concat
 
 let paparazzi_conf = Env.paparazzi_home // "conf"
 let conf_xml = paparazzi_conf // "conf.xml"
-let modules_dir = paparazzi_conf // "modules"
 
 let mkdir = fun d ->
   assert (Sys.command (sprintf "mkdir -p %s" d) = 0)
@@ -59,31 +59,12 @@ let check_unique_id_and_name = fun conf ->
 
 
 
-let pipe_regexp = Str.regexp "|"
-let targets_of_field = fun field ->
-  try
-    Str.split pipe_regexp (ExtXml.attrib_or_default field "target" "ap|sim")
-  with
-    _ -> []
-
 (** [get_modules dir xml]
  * [dir] is the conf directory for modules, [xml] is the parsed airframe.xml *)
 let get_modules = fun dir xml ->
-  (* extract all "modules" sections *)
-  let modules = List.map (fun x ->
-    match String.lowercase (Xml.tag x) with
-      "modules" -> Xml.children x
-    | _ -> []
-    ) (Xml.children xml) in
-  (* flatten the list (result is a list of "load" xml nodes) *)
-  let modules = List.flatten modules in
+  let modules = GC.get_modules_of_airframe xml in
   (* build a list (file name, (xml, xml list of flags)) *)
-  let extract = List.map (fun m ->
-    match String.lowercase (Xml.tag m) with
-      "load" -> let file = dir // ExtXml.attrib m "name" in
-        (file, (ExtXml.parse_file file, Xml.children m))
-    | tag -> failwith (sprintf "Warning: tag load is undefined; found '%s'" tag)
-    ) modules in
+  let extract = List.map GC.get_full_module_conf modules in
   (* return a list of name and a list of pairs (xml, xml list) *)
   List.split extract
 
@@ -94,14 +75,14 @@ let get_modules = fun dir xml ->
  **)
 let dump_module_section = fun xml f ->
   (* get modules *)
-  let (files, modules) = get_modules modules_dir xml in
+  let (files, modules) = get_modules GC.modules_dir xml in
   (* print modules directories and includes for all targets *)
   fprintf f "\n####################################################\n";
   fprintf f   "# modules makefile section\n";
   fprintf f   "####################################################\n";
   fprintf f "\n# include modules directory for all targets\n";
   (* get dir and target list *)
-  let dir_list = get_modules_dir modules in
+  let dir_list = GC.get_modules_dir modules in
 (**
   let target_list = union_of_lists (List.map (fun (m,_) -> get_targets_of_module m) modules) in
   List.iter (fun target -> fprintf f "%s.CFLAGS += -I modules -I arch/$(ARCH)/modules\n" target) target_list;
@@ -115,7 +96,7 @@ let dump_module_section = fun xml f ->
     let dir = try Xml.attrib m "dir" with _ -> name in
     let dir_name = (String.uppercase dir)^"_DIR" in
     (* get the list of all the targets for this module *)
-    let module_target_list = get_targets_of_module m in
+    let module_target_list = GC.get_targets_of_module m in
     (* print global flags as compilation defines and flags *)
     fprintf f "\n# makefile for module %s in modules/%s\n" name dir;
     List.iter (fun flag ->
@@ -135,7 +116,7 @@ let dump_module_section = fun xml f ->
     (* Look for makefile section *)
     List.iter (fun l ->
       if ExtXml.tag_is l "makefile" then begin
-        let targets = targets_of_field l in
+        let targets = GC.targets_of_field l in
         (* Look for defines, flags, files, ... *)
         List.iter (fun field ->
           match String.lowercase (Xml.tag field) with

sw/tools/gen_airframe.ml

@@ -29,7 +29,6 @@ let max_pprz = 9600. (* !!!! MAX_PPRZ From paparazzi.h !!!! *)
 open Printf
 open Xml2h
 
-
 type channel = { min : float; max : float; neutral : float }
 type control = { failsafe_value : int; foo : int }
 
@@ -217,26 +216,6 @@ let parse_ap_only_commands = fun ap_only ->
       printf "  commands[COMMAND_%s] = ap_commands[COMMAND_%s];\\\n" com com
    | _ -> xml_error "copy"
 
-(**
-let parse_subsystem_defines = fun options ->
-  match Xml.tag options with
-    "param" ->
-      printf "//   -param: %s\n"  (ExtXml.attrib options "name")
-   | "define" ->
-      printf "#define %s %s\n"  (ExtXml.attrib options "name")  (ExtXml.attrib options "value")
-   | _ -> xml_error "define|param"
-
-
-let parse_subsystems = fun subsystem ->
-  match Xml.tag subsystem with
-    "param" ->
-      printf "// subsystem parameter: %s\n"  (ExtXml.attrib subsystem "name")
-   | "subsystem" ->
-      printf "// -%s:\n"  (ExtXml.attrib subsystem "name");
-      List.iter parse_subsystem_defines (Xml.children subsystem)
-   | _ -> xml_error "subsystem"
-**)
-
 let parse_command = fun command no ->
    let command_name = "COMMAND_"^ExtXml.attrib command "name" in
    define command_name (string_of_int no);

sw/tools/gen_common.ml

@@ -26,6 +26,8 @@
 
 open Printf
 
+let (//) = Filename.concat
+
 let paparazzi_conf = Env.paparazzi_home // "conf"
 let modules_dir = paparazzi_conf // "modules"
 
@@ -49,31 +51,32 @@ let union_of_lists = fun l ->
   let sl = List.sort compare (List.flatten l) in
   singletonize sl
 
-(* gm *)
-let get_modules = fun dir m ->
+(** [get_modules_of_airframe xml]
+ * Returns a list of modules ("load" node) from airframe file *)
+let get_modules_of_airframe = fun xml ->
+  (* extract all "modules" sections *)
+  let modules = List.map (fun x ->
+    match String.lowercase (Xml.tag x) with
+      "modules" -> Xml.children x
+    | _ -> []
+    ) (Xml.children xml) in
+  (* flatten the list (result is a list of "load" xml nodes) *)
+  List.flatten modules
+
+(** [get_full_module_conf module] Parse module configuration file
+ * Returns module file name and a pair (xml, xml list): parsed file, children *)
+let get_full_module_conf = fun m ->
   match Xml.tag m with
-    "load" -> begin
-      let name = ExtXml.attrib m "name" in
-      let xml = Xml.parse_file (dir^name) in
-      xml
-        end
-  | _ -> xml_error "load"
+    "load" -> let file = modules_dir // ExtXml.attrib m "name" in
+      (file, (ExtXml.parse_file file, Xml.children m))
+  | _ -> Xml2h.xml_error "load"
 
-let unload_unused_modules = fun modules ->
-  let target = try Sys.getenv "TARGET" with _ -> "" in
-  let is_target_in_module = fun m ->
-    let target_is_in_module = List.exists (fun x -> String.compare target x = 0) (get_targets_of_module m) in
-    if not target_is_in_module then
-      Printf.fprintf stderr "Module %s unloaded, target %s not supported\n" (Xml.attrib m "name") target;
-    target_is_in_module
-  in
-  if String.length target = 0 then
-    modules
-  else
-    List.find_all is_target_in_module modules
+(** [get_module_conf module] Parse module configuration file
+ * Returns parsed xml file *)
+let get_module_conf = fun m ->
+  let (_ , (conf, _)) = get_full_module_conf m in
+  conf
 
-
-(* gp *)
 (** [get_targets_of_module xml] Returns the list of targets of a module *)
 let get_targets_of_module = fun m ->
   let pipe_regexp = Str.regexp "|" in
@@ -87,10 +90,16 @@ let get_targets_of_module = fun m ->
   (* return a singletonized list *)
   singletonize (List.sort compare (List.flatten targets))
 
-let unload_unused_modules = fun modules ->
+(* gm *)
+(** [unload_unused_modules modules ?print_error]
+ * Returns a list of [modules] where unused modules are removed
+ * If [print_error] is true, a warning is printed *)
+let unload_unused_modules = fun modules print_error ->
   let target = try Sys.getenv "TARGET" with _ -> "" in
   let is_target_in_module = fun m ->
     let target_is_in_module = List.exists (fun x -> String.compare target x = 0) (get_targets_of_module m) in
+    if print_error && not target_is_in_module then
+      Printf.fprintf stderr "Module %s unloaded, target %s not supported\n" (Xml.attrib m "name") target;
     target_is_in_module
   in
   if String.length target = 0 then
@@ -98,34 +107,32 @@ let unload_unused_modules = fun modules ->
   else
     List.find_all is_target_in_module modules
 
-(** [get_modules_name dir xml] Returns a list of modules name *)
-let get_modules_name = fun dir xml ->
+
+(* gp *)
+(** [get_modules_name xml]
+ * Returns a list of loaded modules' name *)
+let get_modules_name = fun xml ->
   (* extract all "modules" sections *)
-  let modules = List.map (fun x ->
-    match String.lowercase (Xml.tag x) with
-      "modules" -> Xml.children x
-    | _ -> []
-    ) (Xml.children xml) in
-  (* flatten the list (result is a list of "load" xml nodes) *)
-  let modules = List.flatten modules in
+  let modules = get_modules_of_airframe xml in
   (* parse modules *)
-  let modules = List.map (fun m -> ExtXml.parse_file (dir // ExtXml.attrib m "name")) modules in
+  let modules = List.map (fun m -> ExtXml.parse_file (modules_dir // ExtXml.attrib m "name")) modules in
   (* filter the list if target is not supported *)
-  let modules = unload_unused_modules modules in
+  let modules = unload_unused_modules modules false in
   (* return a list of modules name *)
   List.map (fun m -> ExtXml.attrib m "name") modules
 
-(* ga *)
-  (* extract all "modules" sections *)
-  let modules = List.map (fun x ->
-    match String.lowercase (Xml.tag x) with
-      "modules" -> Xml.children x
-    | _ -> []
-    ) (Xml.children xml) in
-  (* flatten the list (result is a list of "load" xml nodes) *)
-  let modules = List.flatten modules in
+(** [targets_of_field]
+ * Returns the targets of a makefile node in modules
+ * Default "ap|sim" *)
+let pipe_regexp = Str.regexp "|"
+let targets_of_field = fun field ->
+  try
+    Str.split pipe_regexp (ExtXml.attrib_or_default field "target" "ap|sim")
+  with
+    _ -> []
 
-(** [get_targets_of_module xml] Returns the list of targets of a module *)
+(** [get_targets_of_module xml]
+ * Returns the list of targets of a module *)
 let get_targets_of_module = fun m ->
   let targets = List.map (fun x ->
     match String.lowercase (Xml.tag x) with
@@ -135,7 +142,8 @@ let get_targets_of_module = fun m ->
   (* return a singletonized list *)
   singletonize (List.sort compare (List.flatten targets))
 
-(** [get_modules_dir xml] Returns the list of modules directories *)
+(** [get_modules_dir xml]
+ * Returns the list of modules directories *)
 let get_modules_dir = fun modules ->
   let dir = List.map (fun (m, _) -> try Xml.attrib m "dir" with _ -> ExtXml.attrib m "name") modules in
   singletonize (List.sort compare dir)

sw/tools/gen_modules.ml

@@ -26,6 +26,7 @@
 
 open Printf
 open Xml2h
+module GC = Gen_common
 
 (** Default main frequency = 60Hz *)
 let freq = ref 60
@@ -123,7 +124,7 @@ let print_periodic_functions = fun modules ->
         ((x, module_name), min 65535 (max 1 (int_of_float (float_of_int !freq /. f))))
       )
     periodic) modules) in
-  let modulos = singletonize (List.map snd functions_modulo) in
+  let modulos = GC.singletonize (List.map snd functions_modulo) in
   (** Print modulos *)
   List.iter (fun modulo ->
     let v = sprintf "i%d" modulo in
@@ -310,11 +311,10 @@ let write_settings = fun xml_file out_set modules ->
 let h_name = "MODULES_H"
 
 let () =
-  if Array.length Sys.argv <> 4 then
-    failwith (Printf.sprintf "Usage: %s conf_modules_dir out_settings_file xml_file" Sys.argv.(0));
-  let xml_file = Sys.argv.(3)
-  and out_set = open_out Sys.argv.(2)
-  and modules_dir = Sys.argv.(1) in
+  if Array.length Sys.argv <> 3 then
+    failwith (Printf.sprintf "Usage: %s out_settings_file xml_file" Sys.argv.(0));
+  let xml_file = Sys.argv.(2)
+  and out_set = open_out Sys.argv.(1) in
   try
     let xml = start_and_begin xml_file h_name in
     fprintf out_h "#define MODULES_IDLE  0\n";
@@ -331,8 +331,8 @@ let () =
     let modules = try (ExtXml.child xml "modules") with _ -> Xml.Element("modules",[],[]) in
     let main_freq = try (int_of_string (Xml.attrib modules "main_freq")) with _ -> !freq in
     freq := main_freq;
-    let modules_list = List.map (get_modules modules_dir) (Xml.children modules) in
-    let modules_list = unload_unused_modules modules_list in
+    let modules_list = List.map GC.get_module_conf (Xml.children modules) in
+    let modules_list = GC.unload_unused_modules modules_list false in
     let modules_name =
       (List.map (fun l -> try Xml.attrib l "name" with _ -> "") (Xml.children modules)) @
       (List.map (fun m -> try Xml.attrib m "name" with _ -> "") modules_list) in

sw/tools/gen_periodic.ml

@@ -25,13 +25,10 @@
  *)
 
 open Printf
+module GC = Gen_common
 
 let (//) = Filename.concat
 
-let paparazzi_conf = Env.paparazzi_home // "conf" 
-let modules_dir = paparazzi_conf // "modules"
-
-
 let margin = ref 0
 let step = 2
 
@@ -42,9 +39,7 @@ let lprintf = fun c f ->
   fprintf c "%s" (String.make !margin ' ');
   fprintf c f
 
-(**let freq = ref 60 *)
-
-let output_modes = fun avr_h process_name channel_name modes freq modules ->       
+let output_modes = fun avr_h process_name channel_name modes freq modules ->
   let min_period = 1./.float freq in
   let max_period = 65536. /. float freq in
   (** For each mode in this process *)
@@ -65,7 +60,7 @@ let output_modes = fun avr_h process_name channel_name modes freq modules ->
           fprintf stderr "Warning: period is bound between %.3fs and %.3fs for message %s\n%!" min_period max_period (ExtXml.attrib x "name");
         (x, min 65535 (max 1 (int_of_float (p*.float_of_int freq))))
         ) filtered_msg in
-      let modulos = singletonize (List.map snd messages) in
+      let modulos = GC.singletonize (List.map snd messages) in
       List.iter (fun m ->
         let v = sprintf "i%d" m in
         let _type = if m >= 256 then "uint16_t" else "uint8_t" in
@@ -111,7 +106,7 @@ let _ =
     with Dtd.Check_error e -> failwith (Dtd.check_error e)
       
   in
-  let modules_name = get_modules_name modules_dir (ExtXml.parse_file Sys.argv.(1)) in
+  let modules_name = GC.get_modules_name (ExtXml.parse_file Sys.argv.(1)) in
 
   let avr_h = stdout in