diff --git a/sw/tools/gen_aircraft.ml b/sw/tools/gen_aircraft.ml index 8a0fa96511..b4850841e6 100644 --- a/sw/tools/gen_aircraft.ml +++ b/sw/tools/gen_aircraft.ml @@ -41,35 +41,35 @@ let check_unique_id_and_name = fun conf -> let ids = Hashtbl.create 5 and names = Hashtbl.create 5 in List.iter - (fun x -> - if String.lowercase (Xml.tag x) = "aircraft" then - let id = ExtXml.attrib x "ac_id" - and name = ExtXml.attrib x "name" in - if Hashtbl.mem ids id then begin - let other_name = Hashtbl.find ids id in - failwith (sprintf "Error: A/C Id '%s' duplicated in %s (%s and %s)" id conf_xml name other_name) - end; - if Hashtbl.mem names name then begin - let other_id = Hashtbl.find names name in - failwith (sprintf "Error: A/C name '%s' duplicated in %s (ids %s and %s)" name conf_xml id other_id) - end; - Hashtbl.add ids id name; - Hashtbl.add names name id) - (Xml.children conf) + (fun x -> + if String.lowercase (Xml.tag x) = "aircraft" then + let id = ExtXml.attrib x "ac_id" + and name = ExtXml.attrib x "name" in + if Hashtbl.mem ids id then begin + let other_name = Hashtbl.find ids id in + failwith (sprintf "Error: A/C Id '%s' duplicated in %s (%s and %s)" id conf_xml name other_name) + end; + if Hashtbl.mem names name then begin + let other_id = Hashtbl.find names name in + failwith (sprintf "Error: A/C name '%s' duplicated in %s (ids %s and %s)" name conf_xml id other_id) + end; + Hashtbl.add ids id name; + Hashtbl.add names name id) + (Xml.children 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") + Str.split pipe_regexp (ExtXml.attrib_or_default field "target" "ap|sim") with - _ -> [] + _ -> [] (** singletonize a sorted list *) let rec singletonize = fun l -> match l with - [] | [_] -> l + [] | [_] -> l | x :: ((y :: t) as yt) -> if x = y then singletonize yt else x :: singletonize yt (** union of two lists *) @@ -87,28 +87,28 @@ let union_of_lists = fun l -> 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 + 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 (* 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 + 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 (* return a list of name and a list of pairs (xml, xml list) *) List.split extract (** [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 - "makefile" -> targets_of_field x - | _ -> [] + match String.lowercase (Xml.tag x) with + "makefile" -> targets_of_field x + | _ -> [] ) (Xml.children m) in (* return a singletonized list *) singletonize (List.sort compare (List.flatten targets)) @@ -120,8 +120,8 @@ let get_modules_dir = fun modules -> (** Search and dump the module section : - xml : the parsed airframe.xml - f : makefile.ac + xml : the parsed airframe.xml + f : makefile.ac **) let dump_module_section = fun xml f -> (* get modules *) @@ -142,71 +142,71 @@ let dump_module_section = fun xml f -> List.iter (fun dir -> let dir_name = (String.uppercase dir)^"_DIR" in fprintf f "%s = modules/%s\n" dir_name dir) dir_list; (* parse each module *) List.iter (fun (m, flags) -> - let name = ExtXml.attrib m "name" in - 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 - (* 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 -> + let name = ExtXml.attrib m "name" in + 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 + (* 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 -> match String.lowercase (Xml.tag flag) with "define" -> let value = Xml.attrib flag "value" and name = Xml.attrib flag "name" in fprintf f "%s = %s\n" name value | "flag" | "param" -> - List.iter (fun target -> - let name = ExtXml.attrib flag "name" - and value = try "="^(Xml.attrib flag "value") with _ -> "" in - fprintf f "%s.CFLAGS += -D%s%s\n" target name value - ) module_target_list + List.iter (fun target -> + let name = ExtXml.attrib flag "name" + and value = try "="^(Xml.attrib flag "value") with _ -> "" in + fprintf f "%s.CFLAGS += -D%s%s\n" target name value + ) module_target_list | _ -> () ) flags; - (* Look for makefile section *) - List.iter (fun l -> - if ExtXml.tag_is l "makefile" then begin - let targets = targets_of_field l in - (* Look for defines, flags, files, ... *) - List.iter (fun field -> - match String.lowercase (Xml.tag field) with - "flag" -> - List.iter (fun target -> - let value = try "="^(Xml.attrib field "value") with _ -> "" - and name = Xml.attrib field "name" in - let flag_type = match (ExtXml.attrib_or_default field "type" "define") with - "define" | "D" -> "D" - | "include" | "I" -> "I" - | _ -> "D" in - fprintf f "%s.CFLAGS += -%s%s%s\n" target flag_type name value - ) targets - | "file" -> - let name = Xml.attrib field "name" in - List.iter (fun target -> fprintf f "%s.srcs += $(%s)/%s\n" target dir_name name) targets - | "file_arch" -> - let name = Xml.attrib field "name" in - List.iter (fun target -> fprintf f "%s.srcs += arch/$(ARCH)/$(%s)/%s\n" target dir_name name) targets - | "file_hw" -> - let name = Xml.attrib field "name" in - List.iter (fun target -> fprintf f "%s.srcs += arch/$(ARCH)/$(%s)/%s\n" target dir_name name) targets - | "define" -> - let value = Xml.attrib field "value" - and name = Xml.attrib field "name" in - fprintf f "%s = %s\n" name value - | "raw" -> - begin match Xml.children field with - [Xml.PCData s] -> fprintf f "%s\n" s - | _ -> fprintf stderr "Warning: wrong makefile section in module '%s'\n" name - end - | _ -> () - ) (Xml.children l) - end) (Xml.children m) - ) modules; + (* Look for makefile section *) + List.iter (fun l -> + if ExtXml.tag_is l "makefile" then begin + let targets = targets_of_field l in + (* Look for defines, flags, files, ... *) + List.iter (fun field -> + match String.lowercase (Xml.tag field) with + "flag" -> + List.iter (fun target -> + let value = try "="^(Xml.attrib field "value") with _ -> "" + and name = Xml.attrib field "name" in + let flag_type = match (ExtXml.attrib_or_default field "type" "define") with + "define" | "D" -> "D" + | "include" | "I" -> "I" + | _ -> "D" in + fprintf f "%s.CFLAGS += -%s%s%s\n" target flag_type name value + ) targets + | "file" -> + let name = Xml.attrib field "name" in + List.iter (fun target -> fprintf f "%s.srcs += $(%s)/%s\n" target dir_name name) targets + | "file_arch" -> + let name = Xml.attrib field "name" in + List.iter (fun target -> fprintf f "%s.srcs += arch/$(ARCH)/$(%s)/%s\n" target dir_name name) targets + | "file_hw" -> + let name = Xml.attrib field "name" in + List.iter (fun target -> fprintf f "%s.srcs += arch/$(ARCH)/$(%s)/%s\n" target dir_name name) targets + | "define" -> + let value = Xml.attrib field "value" + and name = Xml.attrib field "name" in + fprintf f "%s = %s\n" name value + | "raw" -> + begin match Xml.children field with + [Xml.PCData s] -> fprintf f "%s\n" s + | _ -> fprintf stderr "Warning: wrong makefile section in module '%s'\n" name + end + | _ -> () + ) (Xml.children l) + end) (Xml.children m) + ) modules; (** returns a list of modules file name *) files (** - Search and dump the makefile sections + Search and dump the makefile sections **) let dump_makefile_section = fun xml makefile_ac airframe_infile location -> List.iter (fun x -> @@ -220,7 +220,7 @@ let dump_makefile_section = fun xml makefile_ac airframe_infile location -> | _ -> failwith (sprintf "Warning: wrong makefile section in '%s': %s\n" airframe_infile (Xml.to_string_fmt x)) end | (_, _) -> () - end) + end) (Xml.children xml) (** @@ -326,10 +326,10 @@ let is_older = fun target_file dep_files -> not (Sys.file_exists target_file) || let target_file_time = (U.stat target_file).U.st_mtime in let rec loop = function - [] -> false - | f::fs -> - target_file_time < (U.stat f).U.st_mtime || - loop fs in + [] -> false + | f::fs -> + target_file_time < (U.stat f).U.st_mtime || + loop fs in loop dep_files @@ -339,115 +339,115 @@ let make_element = fun t a c -> Xml.Element (t,a,c) (******************************* MAIN ****************************************) let () = try - if Array.length Sys.argv <> 2 then - failwith (sprintf "Usage: %s " Sys.argv.(0)); - let aircraft = Sys.argv.(1) in - let conf = Xml.parse_file conf_xml in - check_unique_id_and_name conf; - let aircraft_xml = - try - ExtXml.child conf ~select:(fun x -> Xml.attrib x "name" = aircraft) "aircraft" - with - Not_found -> failwith (sprintf "Aircraft '%s' not found in '%s'" aircraft conf_xml) - in + if Array.length Sys.argv <> 2 then + failwith (sprintf "Usage: %s " Sys.argv.(0)); + let aircraft = Sys.argv.(1) in + let conf = Xml.parse_file conf_xml in + check_unique_id_and_name conf; + let aircraft_xml = + try + ExtXml.child conf ~select:(fun x -> Xml.attrib x "name" = aircraft) "aircraft" + with + Not_found -> failwith (sprintf "Aircraft '%s' not found in '%s'" aircraft conf_xml) + in - let value = fun attrib -> ExtXml.attrib aircraft_xml attrib in + let value = fun attrib -> ExtXml.attrib aircraft_xml attrib in - let aircraft_dir = Env.paparazzi_home // "var" // aircraft in - let aircraft_conf_dir = aircraft_dir // "conf" in + let aircraft_dir = Env.paparazzi_home // "var" // aircraft in + let aircraft_conf_dir = aircraft_dir // "conf" in - mkdir (Env.paparazzi_home // "var"); - mkdir aircraft_dir; - mkdir (aircraft_dir // "fbw"); - mkdir (aircraft_dir // "autopilot"); - mkdir (aircraft_dir // "sim"); - mkdir aircraft_conf_dir; - mkdir (aircraft_conf_dir // "airframes"); - mkdir (aircraft_conf_dir // "flight_plans"); - mkdir (aircraft_conf_dir // "radios"); - mkdir (aircraft_conf_dir // "settings"); - mkdir (aircraft_conf_dir // "telemetry"); + mkdir (Env.paparazzi_home // "var"); + mkdir aircraft_dir; + mkdir (aircraft_dir // "fbw"); + mkdir (aircraft_dir // "autopilot"); + mkdir (aircraft_dir // "sim"); + mkdir aircraft_conf_dir; + mkdir (aircraft_conf_dir // "airframes"); + mkdir (aircraft_conf_dir // "flight_plans"); + mkdir (aircraft_conf_dir // "radios"); + mkdir (aircraft_conf_dir // "settings"); + mkdir (aircraft_conf_dir // "telemetry"); - let settings = - try value "settings" with - _ -> - fprintf stderr "\nWARNING: No 'settings' attribute specified for A/C '%s', using 'settings/basic.xml'\n\n%!" aircraft; - "settings/basic.xml" in + let settings = + try value "settings" with + _ -> + fprintf stderr "\nWARNING: No 'settings' attribute specified for A/C '%s', using 'settings/basic.xml'\n\n%!" aircraft; + "settings/basic.xml" in - (** Expands the configuration of the A/C into one single file *) - let conf_aircraft = Env.expand_ac_xml aircraft_xml in - let configuration = - make_element - "configuration" - [] - [make_element "conf" [] [conf_aircraft]; Pprz.messages_xml ()] in - let conf_aircraft_file = aircraft_conf_dir // "conf_aircraft.xml" in - let f = open_out conf_aircraft_file in - Printf.fprintf f "%s\n" (ExtXml.to_string_fmt configuration); - close_out f; + (** Expands the configuration of the A/C into one single file *) + let conf_aircraft = Env.expand_ac_xml aircraft_xml in + let configuration = + make_element + "configuration" + [] + [make_element "conf" [] [conf_aircraft]; Pprz.messages_xml ()] in + let conf_aircraft_file = aircraft_conf_dir // "conf_aircraft.xml" in + let f = open_out conf_aircraft_file in + Printf.fprintf f "%s\n" (ExtXml.to_string_fmt configuration); + close_out f; - (** Computes and store a signature of the configuration *) - let md5sum = Digest.to_hex (Digest.file conf_aircraft_file) in - let md5sum_file = aircraft_conf_dir // "aircraft.md5" in - (* Store only if different from previous one *) - if not (Sys.file_exists md5sum_file - && md5sum = input_line (open_in md5sum_file)) then begin - let f = open_out md5sum_file in - Printf.fprintf f "%s\n" md5sum; - close_out f; + (** Computes and store a signature of the configuration *) + let md5sum = Digest.to_hex (Digest.file conf_aircraft_file) in + let md5sum_file = aircraft_conf_dir // "aircraft.md5" in + (* Store only if different from previous one *) + if not (Sys.file_exists md5sum_file + && md5sum = input_line (open_in md5sum_file)) then begin + let f = open_out md5sum_file in + Printf.fprintf f "%s\n" md5sum; + close_out f; - (** Save the configuration for future use *) - let d = U.localtime (U.gettimeofday ()) in - let filename = sprintf "%02d_%02d_%02d__%02d_%02d_%02d_%s_%s.conf" (d.U.tm_year mod 100) (d.U.tm_mon+1) (d.U.tm_mday) (d.U.tm_hour) (d.U.tm_min) (d.U.tm_sec) md5sum aircraft in - let d = Env.paparazzi_home // "var" // "conf" in - mkdir d; - let f = open_out (d // filename) in - Printf.fprintf f "%s\n" (ExtXml.to_string_fmt configuration); - close_out f end; + (** Save the configuration for future use *) + let d = U.localtime (U.gettimeofday ()) in + let filename = sprintf "%02d_%02d_%02d__%02d_%02d_%02d_%s_%s.conf" (d.U.tm_year mod 100) (d.U.tm_mon+1) (d.U.tm_mday) (d.U.tm_hour) (d.U.tm_min) (d.U.tm_sec) md5sum aircraft in + let d = Env.paparazzi_home // "var" // "conf" in + mkdir d; + let f = open_out (d // filename) in + Printf.fprintf f "%s\n" (ExtXml.to_string_fmt configuration); + close_out f end; - let airframe_file = value "airframe" in + let airframe_file = value "airframe" in - let airframe_dir = Filename.dirname airframe_file in - let var_airframe_dir = aircraft_conf_dir // airframe_dir in - mkdir var_airframe_dir; - assert (Sys.command (sprintf "cp %s %s" (paparazzi_conf // airframe_file) var_airframe_dir) = 0); + let airframe_dir = Filename.dirname airframe_file in + let var_airframe_dir = aircraft_conf_dir // airframe_dir in + mkdir var_airframe_dir; + assert (Sys.command (sprintf "cp %s %s" (paparazzi_conf // airframe_file) var_airframe_dir) = 0); - (** Calls the Makefile with target and options *) - let make = fun target options -> - let c = sprintf "make -f Makefile.ac AIRCRAFT=%s AC_ID=%s AIRFRAME_XML=%s TELEMETRY=%s SETTINGS=\"%s\" MD5SUM=\"%s\" %s %s" aircraft (value "ac_id") airframe_file (value "telemetry") settings md5sum options target in - begin (** Quiet is speficied in the Makefile *) - try if Sys.getenv "Q" <> "@" then raise Not_found with - Not_found -> prerr_endline c - end; - let returned_code = Sys.command c in - if returned_code <> 0 then - exit returned_code in + (** Calls the Makefile with target and options *) + let make = fun target options -> + let c = sprintf "make -f Makefile.ac AIRCRAFT=%s AC_ID=%s AIRFRAME_XML=%s TELEMETRY=%s SETTINGS=\"%s\" MD5SUM=\"%s\" %s %s" aircraft (value "ac_id") airframe_file (value "telemetry") settings md5sum options target in + begin (** Quiet is speficied in the Makefile *) + try if Sys.getenv "Q" <> "@" then raise Not_found with + Not_found -> prerr_endline c + end; + let returned_code = Sys.command c in + if returned_code <> 0 then + exit returned_code in - (** Calls the makefile if the optional attribute is available *) - let make_opt = fun target var attr -> - try - let value = Xml.attrib aircraft_xml attr in - make target (sprintf "%s=%s" var value) - with - Xml.No_attribute _ -> () in + (** Calls the makefile if the optional attribute is available *) + let make_opt = fun target var attr -> + try + let value = Xml.attrib aircraft_xml attr in + make target (sprintf "%s=%s" var value) + with + Xml.No_attribute _ -> () in - let temp_makefile_ac = Filename.temp_file "Makefile.ac" "tmp" in - let abs_airframe_file = paparazzi_conf // airframe_file in + let temp_makefile_ac = Filename.temp_file "Makefile.ac" "tmp" in + let abs_airframe_file = paparazzi_conf // airframe_file in - let modules_files = extract_makefile abs_airframe_file temp_makefile_ac in + let modules_files = extract_makefile abs_airframe_file temp_makefile_ac in - (* Create Makefile.ac only if needed *) - let makefile_ac = aircraft_dir // "Makefile.ac" in - if is_older makefile_ac (abs_airframe_file :: modules_files) then begin - assert(Sys.command (sprintf "mv %s %s" temp_makefile_ac makefile_ac) = 0) - end; + (* Create Makefile.ac only if needed *) + let makefile_ac = aircraft_dir // "Makefile.ac" in + if is_older makefile_ac (abs_airframe_file :: modules_files) then begin + assert(Sys.command (sprintf "mv %s %s" temp_makefile_ac makefile_ac) = 0) + end; - (* Get TARGET env, needed to build modules.h according to the target *) - let t = Printf.sprintf "TARGET=%s" (try Sys.getenv "TARGET" with _ -> "") in - make "all_ac_h" t; - make_opt "radio_ac_h" "RADIO" "radio"; - make_opt "flight_plan_ac_h" "FLIGHT_PLAN" "flight_plan" + (* Get TARGET env, needed to build modules.h according to the target *) + let t = Printf.sprintf "TARGET=%s" (try Sys.getenv "TARGET" with _ -> "") in + make "all_ac_h" t; + make_opt "radio_ac_h" "RADIO" "radio"; + make_opt "flight_plan_ac_h" "FLIGHT_PLAN" "flight_plan" with - Failure f -> - prerr_endline f; - exit 1 + Failure f -> + prerr_endline f; + exit 1 diff --git a/sw/tools/gen_airframe.ml b/sw/tools/gen_airframe.ml index f35772e796..f438224ed0 100644 --- a/sw/tools/gen_airframe.ml +++ b/sw/tools/gen_airframe.ml @@ -2,7 +2,7 @@ * $Id$ * * XML preprocessing for airframe parameters - * + * * Copyright (C) 2003-2006 Pascal Brisset, Antoine Drouin * * This file is part of paparazzi. @@ -20,7 +20,7 @@ * You should have received a copy of the GNU General Public License * along with paparazzi; see the file COPYING. If not, write to * the Free Software Foundation, 59 Temple Place - Suite 330, - * Boston, MA 02111-1307, USA. + * Boston, MA 02111-1307, USA. * *) @@ -59,7 +59,7 @@ let define_macro name n x = | 2 -> printf "x1,x2) (%s*(x1)+ %s*(x2))\n" (a "coeff1") (a "coeff2") | 3 -> printf "x1,x2,x3) (%s*(x1)+ %s*(x2)+%s*(x3))\n" (a "coeff1") (a "coeff2") (a "coeff3") | _ -> failwith "define_macro" - + let define_integer name v n = let max_val = 1 lsl n in let print = fun name num den -> @@ -84,11 +84,11 @@ let define_integer name v n = let parse_element = fun prefix s -> match Xml.tag s with "define" -> begin - try - define (prefix^ExtXml.attrib s "name") (ExtXml.display_entities (ExtXml.attrib s "value")); - define_integer (prefix^(ExtXml.attrib s "name")) (ExtXml.float_attrib s "value") (ExtXml.int_attrib s "integer"); - with _ -> (); - end + try + define (prefix^ExtXml.attrib s "name") (ExtXml.display_entities (ExtXml.attrib s "value")); + define_integer (prefix^(ExtXml.attrib s "name")) (ExtXml.float_attrib s "value") (ExtXml.int_attrib s "integer"); + with _ -> (); + end | "linear" -> let name = ExtXml.attrib s "name" and n = int_of_string (ExtXml.attrib s "arity") in @@ -107,7 +107,7 @@ let parse_servo = fun driver c -> let min = fos (ExtXml.attrib c "min" ) and neutral = fos (ExtXml.attrib c "neutral") and max = fos (ExtXml.attrib c "max" ) in - + let travel_up = (max-.neutral) /. max_pprz and travel_down = (neutral-.min) /. max_pprz in @@ -153,7 +153,7 @@ let parse_command_laws = fun command -> let var = a "var" and value = a "value" in let v = preprocess_value value "values" "COMMAND" in - printf " int16_t _var_%s = %s;\\\n" var v + printf " int16_t _var_%s = %s;\\\n" var v | "define" -> parse_element "" command | _ -> xml_error "set|let" @@ -162,7 +162,7 @@ let parse_csc_fields = fun csc_fields -> let a = fun s -> ExtXml.attrib csc_fields s in match Xml.tag csc_fields with "field_map" -> - let servo_id = a "servo_id" + let servo_id = a "servo_id" and field = a "field" in printf " temp.%s = actuators[%s]; \\\n" field servo_id; | _ -> xml_error "field_map" @@ -171,8 +171,8 @@ let parse_csc_messages = (let msg_index_ref = ref 0 in fun csc_id csc_messages - let a = fun s -> ExtXml.attrib csc_messages s in match Xml.tag csc_messages with "msg" -> - let msg_id = a "id" - and msg_type = a "type" + let msg_id = a "id" + and msg_type = a "type" and msg_index = msg_index_ref.contents in msg_index_ref.contents <- msg_index + 1; printf "{\\\n struct Csc%s temp; \\\n" msg_type; @@ -204,7 +204,7 @@ let parse_rc_commands = fun rc -> let var = a "var" and value = a "value" in let v = preprocess_value value "rc_values" "RADIO" in - printf " int16_t _var_%s = %s;\\\n" var v + printf " int16_t _var_%s = %s;\\\n" var v | "define" -> parse_element "" rc | _ -> xml_error "set|let" @@ -221,7 +221,7 @@ let parse_ap_only_commands = fun ap_only -> let parse_subsystem_defines = fun options -> match Xml.tag options with "param" -> - printf "// -param: %s\n" (ExtXml.attrib options "name") + 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" @@ -230,7 +230,7 @@ let parse_subsystem_defines = fun options -> let parse_subsystems = fun subsystem -> match Xml.tag subsystem with "param" -> - printf "// subsystem parameter: %s\n" (ExtXml.attrib subsystem "name") + 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) @@ -307,7 +307,7 @@ let rec parse_section = fun s -> () (** Ignoring this section *) | _ -> () - + let h_name = "AIRFRAME_H" @@ -319,7 +319,7 @@ let hex_to_bin = fun s -> b.[4*i] <- '\\'; Scanf.sscanf (String.sub s (2*i) 2) "%2x" (fun x -> - String.blit (sprintf "%03o" x) 0 b (4*i+1) 3) + String.blit (sprintf "%03o" x) 0 b (4*i+1) 3) done; b diff --git a/sw/tools/gen_flight_plan.ml b/sw/tools/gen_flight_plan.ml index 35357f290d..003c10fdf1 100644 --- a/sw/tools/gen_flight_plan.ml +++ b/sw/tools/gen_flight_plan.ml @@ -2,7 +2,7 @@ * $Id$ * * Flight plan preprocessing (from XML to C) - * + * * Copyright (C) 2004-2008 ENAC, Pascal Brisset, Antoine Drouin * * This file is part of paparazzi. @@ -20,7 +20,7 @@ * You should have received a copy of the GNU General Public License * along with paparazzi; see the file COPYING. If not, write to * the Free Software Foundation, 59 Temple Place - Suite 330, - * Boston, MA 02111-1307, USA. + * Boston, MA 02111-1307, USA. * *) @@ -50,9 +50,9 @@ let parse = fun s -> exit 1 in begin try - Expr_syntax.check_expression e + Expr_syntax.check_expression e with - Expr_syntax.Unknown_operator x -> unexpected "operator" x + Expr_syntax.Unknown_operator x -> unexpected "operator" x | Expr_syntax.Unknown_ident x -> unexpected "ident" x | Expr_syntax.Unknown_function x -> unexpected "function" x end @@ -78,7 +78,7 @@ let lprintf = fun f -> printf f -let float_attrib = fun xml a -> +let float_attrib = fun xml a -> try float_of_string (Xml.attrib xml a) with @@ -101,9 +101,9 @@ let localize_waypoint = fun rel_utm_of_wgs84 waypoint -> try let (x, y) = rel_utm_of_wgs84 - (Latlong.make_geo_deg - (Latlong.deg_of_string (Xml.attrib waypoint "lat")) - (Latlong.deg_of_string (Xml.attrib waypoint "lon"))) in + (Latlong.make_geo_deg + (Latlong.deg_of_string (Xml.attrib waypoint "lat")) + (Latlong.deg_of_string (Xml.attrib waypoint "lon"))) in let x = sprintf "%.2f" x and y = sprintf "%.2f" y in ExtXml.subst_attrib "y" y (ExtXml.subst_attrib "x" x waypoint) with @@ -145,7 +145,7 @@ let element = fun a b c -> Xml.Element (a, b, c) let goto l = element "goto" ["name",l] [] let exit_block = element "exit_block" [] [] let home_block = Xml.parse_string "" - + let stage = ref 0 let output_label l = lprintf "Label(%s)\n" l @@ -161,7 +161,7 @@ let pprz_throttle = fun s -> try let g = float_of_string s in if g < 0. || g > 1. then - failwith "throttle must be > 0 and < 1" + failwith "throttle must be > 0 and < 1" with Failure "float_of_string" -> () (* No possible check on expression *) end; @@ -181,20 +181,20 @@ let output_vmode = fun stage_xml wp last_wp -> begin match vmode with "climb" -> - lprintf "NavVerticalClimbMode(%s);\n" (parsed_attrib stage_xml "climb") + lprintf "NavVerticalClimbMode(%s);\n" (parsed_attrib stage_xml "climb") | "alt" -> - let alt = - try - let a = parsed_attrib stage_xml "alt" in - begin - try - check_altitude (float_of_string a) stage_xml - with - (* Impossible to check the altitude on an expression: *) - Failure "float_of_string" -> () - end; - a - with _ -> + let alt = + try + let a = parsed_attrib stage_xml "alt" in + begin + try + check_altitude (float_of_string a) stage_xml + with + (* Impossible to check the altitude on an expression: *) + Failure "float_of_string" -> () + end; + a + with _ -> try let h = parsed_attrib stage_xml "height" in begin @@ -204,19 +204,19 @@ let output_vmode = fun stage_xml wp last_wp -> (* Impossible to check the altitude on an expression: *) Failure "float_of_string" -> () end; - sprintf "Height(%s)" h + sprintf "Height(%s)" h with _ -> - if wp = "" - then failwith "alt or waypoint required in alt vmode" - else sprintf "WaypointAlt(%s)" wp in - lprintf "NavVerticalAltitudeMode(%s, 0.);\n" alt; + if wp = "" + then failwith "alt or waypoint required in alt vmode" + else sprintf "WaypointAlt(%s)" wp in + lprintf "NavVerticalAltitudeMode(%s, 0.);\n" alt; | "xyz" -> () (** Handled in Goto3D() *) | "glide" -> - lprintf "NavGlide(%s, %s);\n" last_wp wp + lprintf "NavGlide(%s, %s);\n" last_wp wp | "throttle" -> - if (pitch = "auto") then - failwith "auto pich mode not compatible with vmode=throttle"; - lprintf "NavVerticalThrottleMode(%s);\n" (pprz_throttle (parsed_attrib stage_xml "throttle")) + if (pitch = "auto") then + failwith "auto pich mode not compatible with vmode=throttle"; + lprintf "NavVerticalThrottleMode(%s);\n" (pprz_throttle (parsed_attrib stage_xml "throttle")) | x -> failwith (sprintf "Unknown vmode '%s'" x) end; vmode @@ -227,20 +227,20 @@ let output_hmode x wp last_wp = let hmode = ExtXml.attrib x "hmode" in begin match hmode with - "route" -> - if last_wp = "last_wp" then - fprintf stderr "Warning: Deprecated use of 'route' using last waypoint in %s\n"(Xml.to_string x); - lprintf "NavSegment(%s, %s);\n" last_wp wp + "route" -> + if last_wp = "last_wp" then + fprintf stderr "Warning: Deprecated use of 'route' using last waypoint in %s\n"(Xml.to_string x); + lprintf "NavSegment(%s, %s);\n" last_wp wp | "direct" -> lprintf "NavGotoWaypoint(%s);\n" wp | x -> failwith (sprintf "Unknown hmode '%s'" x) end; hmode with ExtXml.Error _ -> lprintf "NavGotoWaypoint(%s);\n" wp; "direct" (* Default behaviour *) - - + + let rec index_stage = fun x -> begin match Xml.tag x with @@ -259,13 +259,13 @@ let rec index_stage = fun x -> Xml.Element (Xml.tag x, Xml.attribs x@["no", soi n], l) | "return" | "goto" | "deroute" | "exit_block" | "follow" | "call" | "home" | "heading" | "attitude" | "go" | "stay" | "xyz" | "set" | "circle" -> - incr stage; - Xml.Element (Xml.tag x, Xml.attribs x@["no", soi !stage], Xml.children x) + incr stage; + Xml.Element (Xml.tag x, Xml.attribs x@["no", soi !stage], Xml.children x) | "survey_rectangle" | "eight" | "oval"-> - incr stage; incr stage; - Xml.Element (Xml.tag x, Xml.attribs x@["no", soi !stage], Xml.children x) + incr stage; incr stage; + Xml.Element (Xml.tag x, Xml.attribs x@["no", soi !stage], Xml.children x) | "exception" -> - x + x | s -> failwith (sprintf "Unknown stage: %s\n" s) end @@ -277,213 +277,213 @@ let rec print_stage = fun index_of_waypoints x -> begin match String.lowercase (Xml.tag x) with "return" -> - stage (); - lprintf "Return()\n"; - lprintf "break\n"; + stage (); + lprintf "Return()\n"; + lprintf "break\n"; | "goto" -> - stage (); - lprintf "Goto(%s)\n" (name_of x) + stage (); + lprintf "Goto(%s)\n" (name_of x) | "deroute" -> - stage (); - lprintf "GotoBlock(%d);\n" (get_index_block (ExtXml.attrib x "block")); - lprintf "break;\n" + stage (); + lprintf "GotoBlock(%d);\n" (get_index_block (ExtXml.attrib x "block")); + lprintf "break;\n" | "exit_block" -> - lprintf "default:\n"; - stage (); - lprintf "NextBlock();\n"; - lprintf "break;\n" + lprintf "default:\n"; + stage (); + lprintf "NextBlock();\n"; + lprintf "break;\n" | "while" -> - let w = gen_label "while" in - let e = gen_label "endwhile" in - output_label w; - stage (); - let c = try parsed_attrib x "cond" with _ -> "TRUE" in - lprintf "if (! (%s)) Goto(%s) else NextStageAndBreak();\n" c e; - List.iter (print_stage index_of_waypoints) (Xml.children x); - print_stage index_of_waypoints (goto w); - output_label e + let w = gen_label "while" in + let e = gen_label "endwhile" in + output_label w; + stage (); + let c = try parsed_attrib x "cond" with _ -> "TRUE" in + lprintf "if (! (%s)) Goto(%s) else NextStageAndBreak();\n" c e; + List.iter (print_stage index_of_waypoints) (Xml.children x); + print_stage index_of_waypoints (goto w); + output_label e | "for" -> - let f = gen_label "for" in - let e = gen_label "endfor" in - let v = Expr_syntax.c_var_of_ident (ExtXml.attrib x "var") - and from_ = parsed_attrib x "from" - and to_expr = parsed_attrib x "to" in - let to_var = v ^ "_to" in - lprintf "static int8_t %s;\n" v; - lprintf "static int8_t %s;\n" to_var; - - (* init *) - stage (); - lprintf "%s = %s - 1;\n" v from_; - lprintf "%s = %s;\n" to_var to_expr; - left (); + let f = gen_label "for" in + let e = gen_label "endfor" in + let v = Expr_syntax.c_var_of_ident (ExtXml.attrib x "var") + and from_ = parsed_attrib x "from" + and to_expr = parsed_attrib x "to" in + let to_var = v ^ "_to" in + lprintf "static int8_t %s;\n" v; + lprintf "static int8_t %s;\n" to_var; - output_label f; - stage (); - lprintf "if (++%s > %s) Goto(%s) else NextStageAndBreak();\n" v to_var e; - List.iter (print_stage index_of_waypoints) (Xml.children x); - print_stage index_of_waypoints (goto f); - output_label e + (* init *) + stage (); + lprintf "%s = %s - 1;\n" v from_; + lprintf "%s = %s;\n" to_var to_expr; + left (); + + output_label f; + stage (); + lprintf "if (++%s > %s) Goto(%s) else NextStageAndBreak();\n" v to_var e; + List.iter (print_stage index_of_waypoints) (Xml.children x); + print_stage index_of_waypoints (goto f); + output_label e | "heading" -> - stage (); - let until = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak() else {\n" until; - right (); - lprintf "NavHeading(RadOfDeg(%s));\n" (parsed_attrib x "course"); - ignore (output_vmode x "" ""); - left (); lprintf "}\n"; - lprintf "break;\n" + stage (); + let until = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak() else {\n" until; + right (); + lprintf "NavHeading(RadOfDeg(%s));\n" (parsed_attrib x "course"); + ignore (output_vmode x "" ""); + left (); lprintf "}\n"; + lprintf "break;\n" | "follow" -> - stage (); - let id = ExtXml.attrib x "ac_id" - and d = ExtXml.attrib x "distance" - and h = ExtXml.attrib x "height" in - lprintf "NavFollow(%s, %s, %s);\n" id d h; - lprintf "break;\n" + stage (); + let id = ExtXml.attrib x "ac_id" + and d = ExtXml.attrib x "distance" + and h = ExtXml.attrib x "height" in + lprintf "NavFollow(%s, %s, %s);\n" id d h; + lprintf "break;\n" | "attitude" -> - stage (); - begin - try - let until = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak() else {\n" until; - with ExtXml.Error _ -> - lprintf "{\n" - end; - right (); - lprintf "NavAttitude(RadOfDeg(%s));\n" (parsed_attrib x "roll"); - ignore (output_vmode x "" ""); - left (); lprintf "}\n"; - lprintf "break;\n" + stage (); + begin + try + let until = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak() else {\n" until; + with ExtXml.Error _ -> + lprintf "{\n" + end; + right (); + lprintf "NavAttitude(RadOfDeg(%s));\n" (parsed_attrib x "roll"); + ignore (output_vmode x "" ""); + left (); lprintf "}\n"; + lprintf "break;\n" | "go" -> - stage (); - let wp = - try - get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints - with - ExtXml.Error _ -> - lprintf "waypoints[0].x = %s;\n" (parsed_attrib x "x"); - lprintf "waypoints[0].y = %s;\n" (parsed_attrib x "y"); - "0" - in - let at = try ExtXml.attrib x "approaching_time" with _ -> "CARROT" in - let last_wp = - try - get_index_waypoint (ExtXml.attrib x "from") index_of_waypoints - with ExtXml.Error _ -> "last_wp" in - if last_wp = "last_wp" then - lprintf "if (NavApproaching(%s,%s)) NextStageAndBreakFrom(%s) else {\n" wp at wp - else - lprintf "if (NavApproachingFrom(%s,%s,%s)) NextStageAndBreakFrom(%s) else {\n" wp last_wp at wp; - right (); - let hmode = output_hmode x wp last_wp in - let vmode = output_vmode x wp last_wp in - if vmode = "glide" && hmode <> "route" then - failwith "glide vmode requires route hmode"; - left (); lprintf "}\n"; - lprintf "break;\n" + stage (); + let wp = + try + get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints + with + ExtXml.Error _ -> + lprintf "waypoints[0].x = %s;\n" (parsed_attrib x "x"); + lprintf "waypoints[0].y = %s;\n" (parsed_attrib x "y"); + "0" + in + let at = try ExtXml.attrib x "approaching_time" with _ -> "CARROT" in + let last_wp = + try + get_index_waypoint (ExtXml.attrib x "from") index_of_waypoints + with ExtXml.Error _ -> "last_wp" in + if last_wp = "last_wp" then + lprintf "if (NavApproaching(%s,%s)) NextStageAndBreakFrom(%s) else {\n" wp at wp + else + lprintf "if (NavApproachingFrom(%s,%s,%s)) NextStageAndBreakFrom(%s) else {\n" wp last_wp at wp; + right (); + let hmode = output_hmode x wp last_wp in + let vmode = output_vmode x wp last_wp in + if vmode = "glide" && hmode <> "route" then + failwith "glide vmode requires route hmode"; + left (); lprintf "}\n"; + lprintf "break;\n" | "stay" -> - stage (); - begin - try - let wp = get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints in - ignore (output_hmode x wp ""); - ignore (output_vmode x wp ""); - with - Xml2h.Error _ -> - lprintf "NavGotoXY(last_x, last_y);\n"; - ignore(output_vmode x "" "") - end; - begin - try - let c = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak();\n" c - with - ExtXml.Error _ -> () - end; - lprintf "break;\n" + stage (); + begin + try + let wp = get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints in + ignore (output_hmode x wp ""); + ignore (output_vmode x wp ""); + with + Xml2h.Error _ -> + lprintf "NavGotoXY(last_x, last_y);\n"; + ignore(output_vmode x "" "") + end; + begin + try + let c = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak();\n" c + with + ExtXml.Error _ -> () + end; + lprintf "break;\n" | "xyz" -> - stage (); - let r = try parsed_attrib x "radius" with _ -> "100" in - lprintf "Goto3D(%s)\n" r; - let x = ExtXml.subst_attrib "vmode" "xyz" x in - ignore (output_vmode x "" ""); (** To handle "pitch" *) - lprintf "break;\n" + stage (); + let r = try parsed_attrib x "radius" with _ -> "100" in + lprintf "Goto3D(%s)\n" r; + let x = ExtXml.subst_attrib "vmode" "xyz" x in + ignore (output_vmode x "" ""); (** To handle "pitch" *) + lprintf "break;\n" | "home" -> - stage (); - lprintf "nav_home();\n"; - lprintf "break;\n" + stage (); + lprintf "nav_home();\n"; + lprintf "break;\n" | "circle" -> - stage (); - let wp = get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints in - let r = parsed_attrib x "radius" in - let _vmode = output_vmode x wp "" in - lprintf "NavCircleWaypoint(%s, %s);\n" wp r; - begin - try - let c = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak();\n" c - with - ExtXml.Error _ -> () - end; - lprintf "break;\n" + stage (); + let wp = get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints in + let r = parsed_attrib x "radius" in + let _vmode = output_vmode x wp "" in + lprintf "NavCircleWaypoint(%s, %s);\n" wp r; + begin + try + let c = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak();\n" c + with + ExtXml.Error _ -> () + end; + lprintf "break;\n" | "eight" -> - stage (); - lprintf "nav_eight_init();\n"; - lprintf "NextStageAndBreak();\n"; - left (); - stage (); - let center = get_index_waypoint (ExtXml.attrib x "center") index_of_waypoints - and turn_about = get_index_waypoint (ExtXml.attrib x "turn_around") index_of_waypoints in - let r = parsed_attrib x "radius" in - let _vmode = output_vmode x center "" in - lprintf "Eight(%s, %s, %s);\n" center turn_about r; - lprintf "break;\n" + stage (); + lprintf "nav_eight_init();\n"; + lprintf "NextStageAndBreak();\n"; + left (); + stage (); + let center = get_index_waypoint (ExtXml.attrib x "center") index_of_waypoints + and turn_about = get_index_waypoint (ExtXml.attrib x "turn_around") index_of_waypoints in + let r = parsed_attrib x "radius" in + let _vmode = output_vmode x center "" in + lprintf "Eight(%s, %s, %s);\n" center turn_about r; + lprintf "break;\n" | "oval" -> - stage (); - lprintf "nav_oval_init();\n"; - lprintf "NextStageAndBreak();\n"; - left (); - stage (); - let p1 = get_index_waypoint (ExtXml.attrib x "p1") index_of_waypoints - and p2 = get_index_waypoint (ExtXml.attrib x "p2") index_of_waypoints in - let r = parsed_attrib x "radius" in - let _vmode = output_vmode x p1 "" in - lprintf "Oval(%s, %s, %s);\n" p1 p2 r; - begin - try - let c = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak();\n" c - with - ExtXml.Error _ -> () - end; - lprintf "break;\n" + stage (); + lprintf "nav_oval_init();\n"; + lprintf "NextStageAndBreak();\n"; + left (); + stage (); + let p1 = get_index_waypoint (ExtXml.attrib x "p1") index_of_waypoints + and p2 = get_index_waypoint (ExtXml.attrib x "p2") index_of_waypoints in + let r = parsed_attrib x "radius" in + let _vmode = output_vmode x p1 "" in + lprintf "Oval(%s, %s, %s);\n" p1 p2 r; + begin + try + let c = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak();\n" c + with + ExtXml.Error _ -> () + end; + lprintf "break;\n" | "set" -> - stage (); - let var = ExtXml.attrib x "var" - and value = parsed_attrib x "value" in - lprintf "%s = %s;\n" var value; - lprintf "NextStageAndBreak();\n"; - lprintf "break;\n" + stage (); + let var = ExtXml.attrib x "var" + and value = parsed_attrib x "value" in + lprintf "%s = %s;\n" var value; + lprintf "NextStageAndBreak();\n"; + lprintf "break;\n" | "call" -> - stage (); - let statement = ExtXml.attrib x "fun" in - lprintf "if (! (%s))\n" statement; - lprintf " NextStageAndBreak();\n"; - lprintf "break;\n" + stage (); + let statement = ExtXml.attrib x "fun" in + lprintf "if (! (%s))\n" statement; + lprintf " NextStageAndBreak();\n"; + lprintf "break;\n" | "survey_rectangle" -> - let grid = parsed_attrib x "grid" - and wp1 = get_index_waypoint (ExtXml.attrib x "wp1") index_of_waypoints - and wp2 = get_index_waypoint (ExtXml.attrib x "wp2") index_of_waypoints - and orientation = ExtXml.attrib_or_default x "orientation" "NS" in - stage (); - if orientation <> "NS" && orientation <> "WE" then - failwith (sprintf "Unknown survey orientation (NS or WE): %s" orientation); - lprintf "NavSurveyRectangleInit(%s, %s, %s, %s);\n" wp1 wp2 grid orientation; - lprintf "NextStageAndBreak();\n"; - left (); - stage (); - lprintf "NavSurveyRectangle(%s, %s);\n" wp1 wp2; - lprintf "break;\n" + let grid = parsed_attrib x "grid" + and wp1 = get_index_waypoint (ExtXml.attrib x "wp1") index_of_waypoints + and wp2 = get_index_waypoint (ExtXml.attrib x "wp2") index_of_waypoints + and orientation = ExtXml.attrib_or_default x "orientation" "NS" in + stage (); + if orientation <> "NS" && orientation <> "WE" then + failwith (sprintf "Unknown survey orientation (NS or WE): %s" orientation); + lprintf "NavSurveyRectangleInit(%s, %s, %s, %s);\n" wp1 wp2 grid orientation; + lprintf "NextStageAndBreak();\n"; + left (); + stage (); + lprintf "NavSurveyRectangle(%s, %s);\n" wp1 wp2; + lprintf "break;\n" | _s -> failwith "Unreachable" end; left () @@ -496,21 +496,21 @@ let indexed_stages = fun blocks -> let block_name = name_of b and block_no = ExtXml.attrib b "no" in let rec f = fun stage -> - try - let stage_no = Xml.attrib stage "no" in - lstages := - Xml.Element ("stage", [ "block", block_no; - "block_name", block_name; - "stage", stage_no], [stage]):: !lstages; - if (ExtXml.tag_is stage "for" || ExtXml.tag_is stage "while") then - List.iter f (Xml.children stage) - with Xml.No_attribute "no" -> - assert (ExtXml.tag_is stage "exception") + try + let stage_no = Xml.attrib stage "no" in + lstages := + Xml.Element ("stage", [ "block", block_no; + "block_name", block_name; + "stage", stage_no], [stage]):: !lstages; + if (ExtXml.tag_is stage "for" || ExtXml.tag_is stage "while") then + List.iter f (Xml.children stage) + with Xml.No_attribute "no" -> + assert (ExtXml.tag_is stage "exception") in List.iter f (Xml.children b)) blocks; !lstages - + @@ -519,17 +519,17 @@ let index_blocks = fun xml -> let indexed_blocks = List.map (fun b -> - incr block; - let name = name_of b in - if List.mem_assoc name !index_of_blocks then - failwith (Printf.sprintf "Error in flight plan: Block '%s' defined twice" name); - index_of_blocks := (name, !block) :: !index_of_blocks; - stage := -1; - let indexed_stages = List.map index_stage (Xml.children b) in - Xml.Element (Xml.tag b, Xml.attribs b@["no", soi !block], indexed_stages)) + incr block; + let name = name_of b in + if List.mem_assoc name !index_of_blocks then + failwith (Printf.sprintf "Error in flight plan: Block '%s' defined twice" name); + index_of_blocks := (name, !block) :: !index_of_blocks; + stage := -1; + let indexed_stages = List.map index_stage (Xml.children b) in + Xml.Element (Xml.tag b, Xml.attribs b@["no", soi !block], indexed_stages)) (Xml.children xml) in Xml.Element (Xml.tag xml, Xml.attribs xml, indexed_blocks) - + let print_block = fun index_of_waypoints (b:Xml.xml) block_num -> @@ -580,10 +580,10 @@ let home = fun waypoints -> let rec loop i = function [] -> failwith "Waypoint 'HOME' required" | w::ws -> - if name_of w = "HOME" then - (float_attrib w "x", float_attrib w "y") - else - loop (i+1) ws in + if name_of w = "HOME" then + (float_attrib w "x", float_attrib w "y") + else + loop (i+1) ws in loop 0 waypoints @@ -593,7 +593,7 @@ let check_distance = fun (hx, hy) max_d wp -> let d = sqrt ((x-.hx)**2. +. (y-.hy)**2.) in if d > max_d then fprintf stderr "\nWarning: Waypoint '%s' too far from HOME (%.0f>%.0f)\n\n" (name_of wp) d max_d - + (* Check coherence between global ref and waypoints ref *) (* Returns a patched xml with utm_x0 and utm_y0 set *) @@ -614,12 +614,12 @@ let check_geo_ref = fun wgs84 xml -> let x = ExtXml.subst_child "waypoints" wpts xml in x -let dummy_waypoint = - Xml.Element ("waypoint", - ["name", "dummy"; - "x", "42."; - "y", "42." ], - []) +let dummy_waypoint = + Xml.Element ("waypoint", + ["name", "dummy"; + "x", "42."; + "y", "42." ], + []) @@ -629,12 +629,12 @@ let print_inside_polygon = fun pts -> if i = j then let {G2D.top=yl; left_side=(xg, ag); right_side=(xd, ad)} = layers.(i) in if xg > xd then begin - lprintf "return FALSE;\n" + lprintf "return FALSE;\n" end else begin - if ad <> 0. || ag <> 0. then - lprintf "float dy = _y - %.1f;\n" yl; - let dy_times = fun f -> if f = 0. then "" else sprintf "+dy*%f" f in - lprintf "return (%.1f%s<= _x && _x <= %.1f%s);\n" xg (dy_times ag) xd (dy_times ad) + if ad <> 0. || ag <> 0. then + lprintf "float dy = _y - %.1f;\n" yl; + let dy_times = fun f -> if f = 0. then "" else sprintf "+dy*%f" f in + lprintf "return (%.1f%s<= _x && _x <= %.1f%s);\n" xg (dy_times ag) xd (dy_times ad) end else let ij2 = (i+j) / 2 in @@ -670,14 +670,14 @@ let parse_wpt_sector = fun waypoints xml -> Not_found -> failwith (sprintf "Error: corner '%s' of sector '%s' not found" name sector_name) in (sector_name, List.map p2D_of (Xml.children xml)) - + (************************** MAIN ******************************************) let () = let xml_file = ref "fligh_plan.xml" and dump = ref false in Arg.parse [ ("-check", Arg.Set check_expressions, "Enable expression checking"); - ("-dump", Arg.Set dump, "Dump compile result") ] + ("-dump", Arg.Set dump, "Dump compile result") ] (fun f -> xml_file := f) "Usage:"; if !xml_file = "" then @@ -718,25 +718,25 @@ let () = let h_name = "FLIGHT_PLAN_H" in printf "/* This file has been generated from %s */\n" !xml_file; printf "/* Please DO NOT EDIT */\n\n"; - + printf "#ifndef %s\n" h_name; Xml2h.define h_name ""; printf "\n"; - + printf "#include \"std.h\"\n"; printf "#include \"modules.h\"\n"; begin - try - let header = ExtXml.child (ExtXml.child xml "header") "0" in - printf "%s\n" (Xml.pcdata header) - with _ -> () + try + let header = ExtXml.child (ExtXml.child xml "header") "0" in + printf "%s\n" (Xml.pcdata header) + with _ -> () end; let name = ExtXml.attrib xml "name" in Xml2h.warning ("FLIGHT PLAN: "^name); Xml2h.define_string "FLIGHT_PLAN_NAME" name; - + let get_float = fun x -> float_attrib xml x in let qfu = try get_float "qfu" with Xml.No_attribute "qfu" -> 0. and mdfh = get_float "max_dist_from_home" @@ -753,9 +753,9 @@ let () = Xml2h.define "NAV_LON0" (sprintf "%d /* 1e7deg */" (convert_angle wgs84.posn_long)); Xml2h.define "NAV_ALT0" (sprintf "%.0f /* cm from msl */" (100. *. !ground_alt)); Xml2h.define "NAV_HMSL0" (sprintf "%.0f /* cm, msl from ellipsoid (EGM96) */" (100. *. Egm96.of_wgs84 wgs84)); - + Xml2h.define "QFU" (sprintf "%.1f" qfu); - + let waypoints = dummy_waypoint :: waypoints in let (hx, hy) = home waypoints in @@ -777,10 +777,10 @@ let () = Xml2h.define "SECURITY_HEIGHT" (sof !security_height); Xml2h.define "SECURITY_ALT" (sof (!security_height +. !ground_alt)); Xml2h.define "MAX_DIST_FROM_HOME" (sof mdfh); - + let index_of_waypoints = - let i = ref (-1) in - List.map (fun w -> incr i; (name_of w, !i)) waypoints in + let i = ref (-1) in + List.map (fun w -> incr i; (name_of w, !i)) waypoints in let sectors_element = try ExtXml.child xml "sectors" with Not_found -> Xml.Element ("", [], []) in let sectors = List.filter (fun x -> String.lowercase (Xml.tag x) = "sector") (Xml.children sectors_element) in @@ -795,7 +795,7 @@ let () = right (); print_blocks index_of_waypoints blocks; lprintf "default: break;\n"; - left (); + left (); lprintf "}\n"; left (); lprintf "}\n"; @@ -812,6 +812,5 @@ let () = Xml2h.finish h_name end with - Failure x -> + Failure x -> fprintf stderr "%s: %s\n" !xml_file x; exit 1 - diff --git a/sw/tools/gen_modules.ml b/sw/tools/gen_modules.ml index 319d6653c6..8c41ea50d9 100644 --- a/sw/tools/gen_modules.ml +++ b/sw/tools/gen_modules.ml @@ -2,7 +2,7 @@ * $Id$ * * XML preprocessing for modules - * + * * Copyright (C) 2009 Gautier Hattenberger * * This file is part of paparazzi. @@ -20,7 +20,7 @@ * You should have received a copy of the GNU General Public License * along with paparazzi; see the file COPYING. If not, write to * the Free Software Foundation, 59 Temple Place - Suite 330, - * Boston, MA 02111-1307, USA. + * Boston, MA 02111-1307, USA. * *) @@ -102,7 +102,7 @@ let remove_dup = fun l -> match l with [] | [_] -> l | x::((x'::_) as xs) -> - if x = x' then loop xs else x::loop xs in + if x = x' then loop xs else x::loop xs in loop (List.sort compare l) let print_periodic_functions = fun modules -> @@ -117,7 +117,7 @@ let print_periodic_functions = fun modules -> let functions_modulo = List.flatten (List.map (fun m -> let periodic = List.filter (fun i -> (String.compare (Xml.tag i) "periodic") == 0) (Xml.children m) in let module_name = ExtXml.attrib m "name" in - List.map (fun x -> + List.map (fun x -> try let p = float_of_string (Xml.attrib x "period") in let _ = try let _ = Xml.attrib x "freq" in fprintf stderr "Warning: both period and freq are defined but only period is used for function %s\n" (ExtXml.attrib x "fun") with _ -> () in @@ -178,7 +178,7 @@ let print_periodic_functions = fun modules -> lprintf out_h "}\n"; end end - else + else begin if (test_delay func) then begin (** Delay is set by user *) @@ -267,16 +267,16 @@ let get_modules = fun dir m -> let name = ExtXml.attrib m "name" in let xml = Xml.parse_file (dir^name) in xml - end + end | _ -> xml_error "load" let test_section_modules = fun xml -> - List.fold_right (fun x r -> ExtXml.tag_is x "modules" || r) (Xml.children xml) false + List.fold_right (fun x r -> ExtXml.tag_is x "modules" || r) (Xml.children xml) false (** Check dependencies *) let pipe_regexp = Str.regexp "|" let dep_of_field = fun field att -> - try + try Str.split pipe_regexp (Xml.attrib field att) with _ -> [] @@ -310,7 +310,7 @@ let write_settings = fun xml_file out_set modules -> match Xml.tag i with "periodic" -> if not (is_status_lock i) then begin - if (not !setting_exist) then begin + if (not !setting_exist) then begin fprintf out_set " \n"; setting_exist := true; end; @@ -326,7 +326,7 @@ let write_settings = fun xml_file out_set modules -> let get_targets_of_module = fun m -> let pipe_regexp = Str.regexp "|" in - let targets_of_field = fun field -> try + let targets_of_field = fun field -> try Str.split pipe_regexp (ExtXml.attrib_or_default field "target" "ap|sim") with _ -> [] in let rec singletonize = fun l -> match l with @@ -380,7 +380,7 @@ let () = 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_name = + 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 check_dependencies modules_list modules_name; diff --git a/sw/tools/gen_settings.ml b/sw/tools/gen_settings.ml index e663f06f8e..35a31412fa 100644 --- a/sw/tools/gen_settings.ml +++ b/sw/tools/gen_settings.ml @@ -2,7 +2,7 @@ * $Id$ * * XML preprocessing for dynamic tuning - * + * * Copyright (C) 2006 Pascal Brisset, Antoine Drouin * * This file is part of paparazzi. @@ -20,7 +20,7 @@ * You should have received a copy of the GNU General Public License * along with paparazzi; see the file COPYING. If not, write to * the Free Software Foundation, 59 Temple Place - Suite 330, - * Boston, MA 02111-1307, USA. + * Boston, MA 02111-1307, USA. * *) @@ -44,50 +44,50 @@ let rec flatten = fun xml r -> match Xml.children xml with [] -> r | x::xs -> - List.iter (fun y -> assert(ExtXml.tag_is y (Xml.tag x))) xs; - List.fold_right flatten (x::xs) r + List.iter (fun y -> assert(ExtXml.tag_is y (Xml.tag x))) xs; + List.fold_right flatten (x::xs) r module StringSet = Set.Make(struct type t = string let compare = compare end) - + let print_dl_settings = fun settings -> let settings = flatten settings [] in (** include headers **) let modules = ref StringSet.empty in - List.iter + List.iter (fun s -> try - modules := StringSet.add (ExtXml.attrib s "module") !modules + modules := StringSet.add (ExtXml.attrib s "module") !modules with ExtXml.Error e -> () - ) + ) settings; lprintf "\n"; StringSet.iter (fun m -> lprintf "#include \"%s.h\"\n" m) !modules; lprintf "#include \"modules.h\"\n"; lprintf "\n"; - + (** Macro to call to set one variable *) lprintf "#define DlSetting(_idx, _value) { \\\n"; right (); lprintf "switch (_idx) { \\\n"; right (); let idx = ref 0 in - List.iter + List.iter (fun s -> let v = ExtXml.attrib s "var" in - begin - try - let h = ExtXml.attrib s "handler" and - m = ExtXml.attrib s "module" in - lprintf "case %d: %s_%s( _value ); _value = %s; break;\\\n" !idx (Filename.basename m) h v - with - ExtXml.Error e -> lprintf "case %d: %s = _value; break;\\\n" !idx v - end; - incr idx - ) + begin + try + let h = ExtXml.attrib s "handler" and + m = ExtXml.attrib s "module" in + lprintf "case %d: %s_%s( _value ); _value = %s; break;\\\n" !idx (Filename.basename m) h v + with + ExtXml.Error e -> lprintf "case %d: %s = _value; break;\\\n" !idx v + end; + incr idx + ) settings; lprintf "default: break;\\\n"; left (); @@ -106,10 +106,10 @@ let print_dl_settings = fun settings -> let idx = ref 0 in lprintf "switch (i) { \\\n"; right (); - List.iter + List.iter (fun s -> - let v = ExtXml.attrib s "var" in - lprintf "case %d: var = %s; break;\\\n" !idx v; incr idx) + let v = ExtXml.attrib s "var" in + lprintf "case %d: var = %s; break;\\\n" !idx v; incr idx) settings; lprintf "default: var = 0.; break;\\\n"; left (); @@ -126,16 +126,16 @@ let print_dl_settings = fun settings -> let idx = ref 0 in lprintf "switch (i) { \\\n"; right (); - List.iter + List.iter (fun s -> let v = ExtXml.attrib s "var" in - lprintf "case %d: return %s;\n" !idx v; incr idx) + lprintf "case %d: return %s;\n" !idx v; incr idx) settings; lprintf "default: return 0.;\n"; lprintf "}\n"; left (); lprintf "}\n" - + @@ -190,12 +190,12 @@ let join_xml_files = fun xml_files -> and rc_settings = ref [] in List.iter (fun xml_file -> let xml = Xml.parse_file xml_file in - let these_rc_settings = + let these_rc_settings = try Xml.children (ExtXml.child xml "rc_settings") with - Not_found -> [] in - let these_dl_settings = - try Xml.children (ExtXml.child xml "dl_settings") with - Not_found -> [] in + Not_found -> [] in + let these_dl_settings = + try Xml.children (ExtXml.child xml "dl_settings") with + Not_found -> [] in rc_settings := these_rc_settings @ !rc_settings; dl_settings := these_dl_settings @ !dl_settings) xml_files; @@ -211,11 +211,11 @@ let _ = for i = 2 to Array.length Sys.argv - 1 do xml_files := Sys.argv.(i) :: !xml_files; done; - + try printf "/* This file has been generated from %s */\n" (String.concat " " !xml_files); printf "/* Please DO NOT EDIT */\n\n"; - + printf "#ifndef %s\n" h_name; define h_name ""; nl ();