diff --git a/.gitignore b/.gitignore index 65869e83e6..d5bba5a95a 100644 --- a/.gitignore +++ b/.gitignore @@ -31,23 +31,6 @@ /build.properties /META-INF -# Debian related files -*.deb -*.dsc -*.changes -*.substvars -*.debhelper.log -*-stamp -/debian/control -/debian/changelog -/debian/files -/debian/paparazzi-arm7 -/debian/paparazzi-avr -/debian/paparazzi-dev -/debian/paparazzi-bin -/sw/lib/ocaml/ivy/debian/changelog -/sw/lib/ocaml/ivy/debian/files -/sw/lib/ocaml/ivy/debian/ivy-ocaml /var /dox @@ -118,6 +101,7 @@ /sw/lib/ocaml/expr_parser.mli /sw/lib/ocaml/gtk_papget_led_editor.ml /sw/lib/ocaml/expr_lexer.ml +/sw/lib/ocaml/META.pprz # /sw/logalizer/ /sw/logalizer/plot diff --git a/Makefile b/Makefile index 45206cabaf..398ae45943 100644 --- a/Makefile +++ b/Makefile @@ -45,6 +45,14 @@ OCAML=$(shell which ocaml) OCAMLRUN=$(shell which ocamlrun) BUILD_DATETIME:=$(shell date +%Y%m%d-%H%M%S) +# default mktemp in OS X doesn't work, use gmktemp with macports coreutils +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + MKTEMP = gmktemp +else + MKTEMP = mktemp +endif + # # define some paths # @@ -57,6 +65,7 @@ MULTIMON=sw/ground_segment/multimon COCKPIT=sw/ground_segment/cockpit TMTC=sw/ground_segment/tmtc TOOLS=$(PAPARAZZI_SRC)/sw/tools +JOYSTICK=sw/ground_segment/joystick EXT=sw/ext # @@ -92,9 +101,6 @@ ABI_MESSAGES_H=$(STATICINCLUDE)/abi_messages.h GEN_HEADERS = $(MESSAGES_H) $(MESSAGES2_H) $(UBX_PROTOCOL_H) $(MTK_PROTOCOL_H) $(XSENS_PROTOCOL_H) $(DL_PROTOCOL_H) $(DL_PROTOCOL2_H) $(ABI_MESSAGES_H) -# default directory for temporary files -TMPDIR ?= /tmp - all: ground_segment ext lpctools print_build_version: @@ -111,26 +117,29 @@ conf/%.xml :conf/%.xml.example [ -L $@ ] || [ -f $@ ] || cp $< $@ -ground_segment: print_build_version update_google_version conf lib subdirs commands static +ground_segment: print_build_version update_google_version conf libpprz subdirs commands static -static: cockpit tmtc tools sim_static static_h +static: cockpit tmtc tools sim_static joystick static_h -lib: +libpprz: $(MAKE) -C $(LIB)/ocaml multimon: $(MAKE) -C $(MULTIMON) -cockpit: lib +cockpit: libpprz $(MAKE) -C $(COCKPIT) -tmtc: lib cockpit multimon +tmtc: libpprz cockpit multimon $(MAKE) -C $(TMTC) -tools: lib +tools: libpprz $(MAKE) -C $(TOOLS) -sim_static: lib +joystick: libpprz + $(MAKE) -C $(JOYSTICK) + +sim_static: libpprz $(MAKE) -C $(SIMULATOR) ext: @@ -144,56 +153,70 @@ subdirs: $(SUBDIRS) $(SUBDIRS): $(MAKE) -C $@ -$(PPRZCENTER): lib +$(PPRZCENTER): libpprz -$(LOGALIZER): lib +$(LOGALIZER): libpprz static_h: $(GEN_HEADERS) $(MESSAGES_H) : $(MESSAGES_XML) tools $(Q)test -d $(STATICINCLUDE) || mkdir -p $(STATICINCLUDE) - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages.out $< telemetry > $(TMPDIR)/msg.h - $(Q)mv $(TMPDIR)/msg.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages.out $< telemetry > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(MESSAGES2_H) : $(MESSAGES_XML) tools $(Q)test -d $(STATICINCLUDE) || mkdir -p $(STATICINCLUDE) - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages2.out $< telemetry > $(TMPDIR)/msg2.h - $(Q)mv $(TMPDIR)/msg2.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages2.out $< telemetry > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(UBX_PROTOCOL_H) : $(UBX_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_ubx.out $< > $(TMPDIR)/ubx.h - $(Q)mv $(TMPDIR)/ubx.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_ubx.out $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(MTK_PROTOCOL_H) : $(MTK_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_mtk.out $< > $(TMPDIR)/mtk.h - $(Q)mv $(TMPDIR)/mtk.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_mtk.out $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(XSENS_PROTOCOL_H) : $(XSENS_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_xsens.out $< > $(TMPDIR)/xsens.h - $(Q)mv $(TMPDIR)/xsens.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_xsens.out $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(DL_PROTOCOL_H) : $(MESSAGES_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages.out $< datalink > $(TMPDIR)/dl.h - $(Q)mv $(TMPDIR)/dl.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages.out $< datalink > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(DL_PROTOCOL2_H) : $(MESSAGES_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages2.out $< datalink > $(TMPDIR)/dl2.h - $(Q)mv $(TMPDIR)/dl2.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages2.out $< datalink > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(ABI_MESSAGES_H) : $(MESSAGES_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_abi.out $< airborne > $(TMPDIR)/abi.h - $(Q)mv $(TMPDIR)/abi.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_abi.out $< airborne > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ include Makefile.ac @@ -218,19 +241,12 @@ paparazzi: chmod a+x $@ -install : - $(MAKE) -f Makefile.install PREFIX=$(PREFIX) - -uninstall : - $(MAKE) -f Makefile.install PREFIX=$(PREFIX) uninstall - - # # Cleaning # clean: - $(Q)rm -fr dox build-stamp configure-stamp conf/%gconf.xml debian/files debian/paparazzi-base debian/paparazzi-bin paparazzi + $(Q)rm -fr dox build-stamp configure-stamp conf/%gconf.xml $(Q)rm -f $(GEN_HEADERS) $(Q)find . -mindepth 2 -name Makefile -a ! -path "./sw/ext/*" -exec sh -c 'echo "Cleaning {}"; $(MAKE) -C `dirname {}` $@' \; $(Q)$(MAKE) -C $(EXT) clean @@ -274,7 +290,7 @@ test: all replace_current_conf_xml run_tests restore_conf_xml .PHONY: all print_build_version update_google_version ground_segment \ -subdirs $(SUBDIRS) conf ext lib multimon cockpit tmtc tools\ -static sim_static lpctools commands install uninstall \ +subdirs $(SUBDIRS) conf ext libpprz multimon cockpit tmtc tools\ +static sim_static lpctools commands \ clean cleanspaces ab_clean dist_clean distclean dist_clean_irreversible \ test replace_current_conf_xml run_tests restore_conf_xml diff --git a/Makefile.ac b/Makefile.ac index 22b883e59b..90e2b5e3d0 100644 --- a/Makefile.ac +++ b/Makefile.ac @@ -49,6 +49,13 @@ MODULES_DIR=$(PAPARAZZI_HOME)/conf/modules/ AUTOPILOT_H=$(AC_GENERATED)/autopilot_core.h AIRCRAFT_MD5=$(AIRCRAFT_CONF_DIR)/aircraft.md5 +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + MKTEMP = gmktemp +else + MKTEMP = mktemp +endif + # "make Q=''" to get full echo Q=@ @@ -62,9 +69,6 @@ endif # telemetry periodic frequency defaults to 60Hz TELEMETRY_FREQUENCY ?= 60 -# default directory for temporary files -TMPDIR ?= /tmp - init: @[ -d $(PAPARAZZI_HOME) ] || (echo "Copying config example in your $(PAPARAZZI_HOME) directory"; mkdir -p $(PAPARAZZI_HOME); cp -a conf $(PAPARAZZI_HOME); cp -a data $(PAPARAZZI_HOME); mkdir -p $(PAPARAZZI_HOME)/var/maps; mkdir -p $(PAPARAZZI_HOME)/var/include) @@ -89,56 +93,70 @@ makefile_ac: $(MAKEFILE_AC) $(AIRFRAME_H) : $(CONF)/$(AIRFRAME_XML) $(CONF_XML) $(AIRCRAFT_MD5) $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_airframe.out $(AC_ID) $(AIRCRAFT) $(MD5SUM) $< > $(TMPDIR)/airframe.h - $(Q)mv $(TMPDIR)/airframe.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)$(TOOLS)/gen_airframe.out $(AC_ID) $(AIRCRAFT) $(MD5SUM) $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(Q)cp $(CONF)/airframes/airframe.dtd $(AIRCRAFT_CONF_DIR)/airframes $(RADIO_H) : $(CONF)/$(RADIO) $(CONF_XML) $(TOOLS)/gen_radio.out $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_radio.out $< > $(TMPDIR)/radio.h - $(Q)mv $(TMPDIR)/radio.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)$(TOOLS)/gen_radio.out $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(Q)cp $< $(AIRCRAFT_CONF_DIR)/radios $(PERIODIC_H) : $(CONF)/$(AIRFRAME_XML) $(MESSAGES_XML) $(CONF_XML) $(CONF)/$(TELEMETRY) $(MAKEFILE_AC) $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_periodic.out $(CONF)/$(AIRFRAME_XML) $(MESSAGES_XML) $(CONF)/$(TELEMETRY) $(TELEMETRY_FREQUENCY) $(SETTINGS_TELEMETRY) > $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)$(TOOLS)/gen_periodic.out $(CONF)/$(AIRFRAME_XML) $(MESSAGES_XML) $(CONF)/$(TELEMETRY) $(TELEMETRY_FREQUENCY) $(SETTINGS_TELEMETRY) > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ - $(Q)cp $< $(AIRCRAFT_CONF_DIR) $(Q)cp $(CONF)/$(TELEMETRY) $(AIRCRAFT_CONF_DIR)/telemetry $(FLIGHT_PLAN_H) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(TOOLS)/gen_flight_plan.out $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_flight_plan.out $< > $(TMPDIR)/$(AC_ID)_fp.h - $(Q)mv $(TMPDIR)/$(AC_ID)_fp.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)$(TOOLS)/gen_flight_plan.out $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(Q)cp $< $(AIRCRAFT_CONF_DIR)/flight_plans $(FLIGHT_PLAN_XML) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(TOOLS)/gen_flight_plan.out - @echo BUILD $@ - $(Q)$(TOOLS)/gen_flight_plan.out -dump $< > $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)$(TOOLS)/gen_flight_plan.out -dump $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(SETTINGS_H) : $(SETTINGS_XMLS) $(CONF_XML) $(SETTINGS_MODULES) $(SETTINGS_TELEMETRY) $(TOOLS)/gen_settings.out $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_settings.out $(SETTINGS_XML) $(SETTINGS_TELEMETRY) $(SETTINGS_XMLS) $(SETTINGS_MODULES) > $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)$(TOOLS)/gen_settings.out $(SETTINGS_XML) $(SETTINGS_TELEMETRY) $(SETTINGS_XMLS) $(SETTINGS_MODULES) > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(Q)cp $(SETTINGS_XMLS) $(AIRCRAFT_CONF_DIR)/settings $(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 $(SETTINGS_MODULES) $< > $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)$(TOOLS)/gen_modules.out $(SETTINGS_MODULES) $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(AUTOPILOT_H) : $(CONF)/$(AIRFRAME_XML) $(TOOLS)/gen_autopilot.out $(CONF)/autopilot/*.xml $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_autopilot.out $(CONF)/$(AIRFRAME_XML) $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell $(MKTEMP))) + $(Q)$(TOOLS)/gen_autopilot.out $(CONF)/$(AIRFRAME_XML) $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(SETTINGS_MODULES) : $(MODULES_H) @@ -155,7 +173,7 @@ $(SETTINGS_TELEMETRY) : $(PERIODIC_H) %.upload: %.compile cd $(AIRBORNE); $(MAKE) TARGET=$* upload -jsbsim jsbsim.compile: jsbsim.ac_h +jsbsim jsbsim.compile: jsbsim.ac_h print_version cd $(AIRBORNE); $(MAKE) TARGET=jsbsim ARCHI=jsbsim ARCH=jsbsim all sim sim.compile: sim.ac_h print_version diff --git a/Makefile.install b/Makefile.install deleted file mode 100644 index 9cea7867ac..0000000000 --- a/Makefile.install +++ /dev/null @@ -1,159 +0,0 @@ -# Hey Emacs, this is a -*- makefile -*- - -# Installation of the files in the system tree - -PREFIX=/ -DESTDIR=$(PREFIX)/usr/share/paparazzi -INSTALL=install -o root -INSTALLDATA=install -o root -m 644 - -install : install_files -# post_install - -install_files: install_data install_conf install_bin install_libs install_tools install_airborne_sources - -post_install : - debian/paparazzi-bin.postinst - -install_data: - $(INSTALL) -d $(DESTDIR)/data/maps - $(INSTALLDATA) data/maps/muret_UTM.xml data/maps/muret_UTM.gif $(DESTDIR)/data/maps - $(INSTALL) -d $(DESTDIR)/data/pictures/gcs_icons - $(INSTALLDATA) data/pictures/*.gif data/pictures/*.svg data/pictures/*.jpg data/pictures/*.png $(DESTDIR)/data/pictures - $(INSTALLDATA) data/pictures/gcs_icons/*.png $(DESTDIR)/data/pictures/gcs_icons - $(INSTALL) -d $(PREFIX)/usr/share/pixmaps - $(INSTALLDATA) data/pictures/penguin_icon.png $(PREFIX)/usr/share/pixmaps/paparazzi.png - $(INSTALL) -d $(DESTDIR)/data/srtm - - -install_conf: - $(INSTALL) -d $(DESTDIR)/conf - $(INSTALLDATA) conf/conf.xml.example $(DESTDIR)/conf/conf.xml - $(INSTALLDATA) conf/control_panel.xml.example $(DESTDIR)/conf/control_panel.xml - $(INSTALLDATA) conf/messages.xml $(DESTDIR)/conf/ - $(INSTALLDATA) conf/messages.dtd $(DESTDIR)/conf/ - $(INSTALLDATA) conf/gui.xml $(DESTDIR)/conf/ - $(INSTALL) -d $(DESTDIR)/conf/airframes - $(INSTALLDATA) conf/airframes/airframe.dtd $(DESTDIR)/conf/airframes - $(INSTALLDATA) conf/airframes/microjet_example.xml $(DESTDIR)/conf/airframes - $(INSTALLDATA) conf/airframes/twinstar_example.xml $(DESTDIR)/conf/airframes - $(INSTALLDATA) conf/airframes/twinjet_example.xml $(DESTDIR)/conf/airframes - $(INSTALLDATA) conf/airframes/example_twog_analogimu.xml $(DESTDIR)/conf/airframes - $(INSTALL) -d $(DESTDIR)/conf/autopilot - $(INSTALLDATA) conf/autopilot/*.makefile $(DESTDIR)/conf/autopilot - $(INSTALLDATA) conf/autopilot/*.h $(DESTDIR)/conf/autopilot - $(INSTALL) -d $(DESTDIR)/conf/autopilot/subsystems - $(INSTALLDATA) conf/autopilot/subsystems/*.makefile $(DESTDIR)/conf/autopilot/subsystems - $(INSTALL) -d $(DESTDIR)/conf/autopilot/subsystems/fixedwing - $(INSTALLDATA) conf/autopilot/subsystems/fixedwing/*.makefile $(DESTDIR)/conf/autopilot/subsystems/fixedwing - $(INSTALL) -d $(DESTDIR)/conf/autopilot/subsystems/rotorcraft - $(INSTALLDATA) conf/autopilot/subsystems/rotorcraft/*.makefile $(DESTDIR)/conf/autopilot/subsystems/rotorcraft - $(INSTALL) -d $(DESTDIR)/conf/autopilot/subsystems/shared - $(INSTALLDATA) conf/autopilot/subsystems/shared/*.makefile $(DESTDIR)/conf/autopilot/subsystems/shared - $(INSTALL) -d $(DESTDIR)/conf/flight_plans - $(INSTALLDATA) conf/flight_plans/*.dtd $(DESTDIR)/conf/flight_plans - $(INSTALLDATA) conf/flight_plans/*.xml $(DESTDIR)/conf/flight_plans - $(INSTALL) -d $(DESTDIR)/conf/modules - $(INSTALLDATA) conf/modules/*.dtd $(DESTDIR)/conf/modules - $(INSTALLDATA) conf/modules/*.xml $(DESTDIR)/conf/modules - $(INSTALL) -d $(DESTDIR)/conf/gps - $(INSTALLDATA) conf/gps/Makefile $(DESTDIR)/conf/gps - $(INSTALLDATA) conf/gps/ublox_conf.c $(DESTDIR)/conf/gps - $(INSTALLDATA) conf/gps/README $(DESTDIR)/conf/gps - $(INSTALLDATA) conf/gps/*.inf $(DESTDIR)/conf/gps - $(INSTALLDATA) conf/gps/*.txt $(DESTDIR)/conf/gps - $(INSTALL) -d $(DESTDIR)/conf/radios - $(INSTALLDATA) conf/radios/radio.dtd $(DESTDIR)/conf/radios - $(INSTALLDATA) conf/radios/*.xml $(DESTDIR)/conf/radios - $(INSTALL) -d $(DESTDIR)/conf/telemetry - $(INSTALLDATA) conf/telemetry/telemetry.dtd $(DESTDIR)/conf/telemetry - $(INSTALLDATA) conf/telemetry/*.xml $(DESTDIR)/conf/telemetry - $(INSTALL) -d $(DESTDIR)/conf/settings - $(INSTALLDATA) conf/settings/settings.dtd $(DESTDIR)/conf/settings - $(INSTALLDATA) conf/settings/*.xml $(DESTDIR)/conf/settings - $(INSTALL) -d $(DESTDIR)/conf/gcs - $(INSTALLDATA) conf/gcs/layout.dtd $(DESTDIR)/conf/gcs - $(INSTALLDATA) conf/gcs/*.xml $(DESTDIR)/conf/gcs - $(INSTALL) -d $(PREFIX)/etc/udev/rules.d - $(INSTALLDATA) conf/system/udev/rules/*.rules $(PREFIX)/etc/udev/rules.d - $(INSTALL) -d $(PREFIX)/etc/modprobe.d - $(INSTALLDATA) conf/system/modprobe.d/paparazzi $(PREFIX)/etc/modprobe.d - $(INSTALL) -d $(PREFIX)/usr/share/applications - $(INSTALLDATA) debian/paparazzi.desktop $(PREFIX)/usr/share/applications - - -install_bin: - $(INSTALL) -d $(PREFIX)/usr/bin/ - $(INSTALL) -d $(DESTDIR)/sw/supervision - $(INSTALL) sw/supervision/paparazzicenter.glade $(DESTDIR)/sw/supervision - $(INSTALL) sw/supervision/*.cmo $(DESTDIR)/sw/supervision - $(INSTALL) paparazzi-make $(PREFIX)/usr/bin/ - $(INSTALLDATA) -d $(DESTDIR)/sw/simulator - $(INSTALL) sw/simulator/*.cmo $(DESTDIR)/sw/simulator - $(INSTALL) sw/simulator/pprzsim-launch $(DESTDIR)/sw/simulator - $(INSTALL) -d $(DESTDIR)/sw/ground_segment/cockpit - $(INSTALL) -d $(DESTDIR)/sw/ground_segment/tmtc - $(INSTALL) -d $(DESTDIR)/sw/ground_segment/multimon - $(INSTALLDATA) sw/ground_segment/cockpit/*.cmo $(DESTDIR)/sw/ground_segment/cockpit - $(INSTALLDATA) sw/ground_segment/cockpit/gcs.glade $(DESTDIR)/sw/ground_segment/cockpit - $(INSTALLDATA) sw/ground_segment/tmtc/*.cmo $(DESTDIR)/sw/ground_segment/tmtc - $(INSTALL) sw/ground_segment/tmtc/boa $(DESTDIR)/sw/ground_segment/tmtc - $(INSTALLDATA) sw/ground_segment/multimon/multimon.cma $(DESTDIR)/sw/ground_segment/multimon - $(INSTALLDATA) sw/ground_segment/multimon/libmultimon.a $(DESTDIR)/sw/ground_segment/multimon - $(INSTALLDATA) sw/ground_segment/multimon/dllmultimon.so $(DESTDIR)/sw/ground_segment/multimon - $(INSTALL) -d $(DESTDIR)/sw/logalizer - $(INSTALLDATA) sw/logalizer/*.cm[ox] $(DESTDIR)/sw/logalizer - $(INSTALLDATA) sw/logalizer/*.o $(DESTDIR)/sw/logalizer - $(INSTALLDATA) sw/logalizer/export.glade $(DESTDIR)/sw/logalizer - ln -sf ../share/paparazzi/sw/supervision/paparazzicenter $(PREFIX)/usr/bin/paparazzi - -install_libs: - $(INSTALL) -d $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/*.cma $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/*.cmxa $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/*.so $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/*.a $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/*.cmi $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/myGtkInit.cmo $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/widgets.glade $(DESTDIR)/sw/lib/ocaml - -install_tools: - $(INSTALLDATA) Makefile.ac $(DESTDIR) - $(INSTALLDATA) conf/Makefile* $(DESTDIR)/conf - $(INSTALL) -d $(DESTDIR)/sw/tools/ - $(INSTALL) sw/tools/*.out $(DESTDIR)/sw/tools/ - rm -f $(DESTDIR)/sw/tools/gen_flight_plan.out - $(INSTALLDATA) sw/tools/fp_proc.cmo $(DESTDIR)/sw/tools - $(INSTALLDATA) sw/tools/gen_flight_plan.cmo $(DESTDIR)/sw/tools - $(INSTALLDATA) sw/tools/gen_aircraft.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_airframe.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_messages.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_periodic.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_radio.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_settings.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_ubx.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_mtk.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_xsens.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_modules.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_common.cmo $(DESTDIR)/sw/tools/ - $(INSTALL) -d $(DESTDIR)/sw/tools/calibration - $(INSTALLDATA) sw/tools/calibration/calibrate.py $(DESTDIR)/sw/tools/calibration - $(INSTALLDATA) sw/tools/calibration/calibrate_gyro.py $(DESTDIR)/sw/tools/calibration - $(INSTALLDATA) sw/tools/calibration/calibration_utils.py $(DESTDIR)/sw/tools/calibration - $(INSTALLDATA) sw/tools/calibration/README $(DESTDIR)/sw/tools/calibration - $(INSTALL) -d $(DESTDIR)/sw/ground_segment/lpc21iap - $(INSTALL) sw/ground_segment/lpc21iap/lpc21iap $(DESTDIR)/sw/ground_segment/lpc21iap/ - $(INSTALL) -d $(DESTDIR)/sw/simulator - $(INSTALLDATA) sw/simulator/sitl.cma $(DESTDIR)/sw/simulator - $(INSTALLDATA) sw/simulator/simsitl.ml $(DESTDIR)/sw/simulator - $(INSTALLDATA) sw/simulator/sim.cmi $(DESTDIR)/sw/simulator - $(INSTALLDATA) sw/simulator/sitl.cmi $(DESTDIR)/sw/simulator - $(INSTALLDATA) sw/simulator/libsitl.a $(DESTDIR)/sw/simulator - $(INSTALL) sw/simulator/simhitl $(DESTDIR)/sw/simulator - -install_airborne_sources: - $(INSTALL) -d $(DESTDIR)/sw/ - tar -cf - sw/airborne/ | tar -C $(DESTDIR) -xf - - $(INSTALL) -d $(DESTDIR)/sw/include - $(INSTALLDATA) sw/include/std.h $(DESTDIR)/sw/include - $(INSTALLDATA) var/include/*.h $(DESTDIR)/sw/include diff --git a/conf/Makefile.avr b/conf/Makefile.avr deleted file mode 100644 index 7f38e698cd..0000000000 --- a/conf/Makefile.avr +++ /dev/null @@ -1,190 +0,0 @@ -# Hey Emacs, this is a -*- makefile -*- -# -# $Id$ -# Copyright (C) 2003-2005 Pascal Brisset, Antoine Drouin -# -# This file is part of paparazzi. -# -# paparazzi 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 2, or (at your option) -# any later version. -# -# paparazzi 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 paparazzi; see the file COPYING. If not, write to -# the Free Software Foundation, 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. -# - - -# -# This is the common Makefile for the avr-target. -# Edit the configuration part to suit your local install -# - -ATMELBIN = /usr/bin -ATMEL_INCLUDES = -I /usr/avr/include -ATMEL_LIBPATH = -B /usr/avr/lib/avr4 -B /usr/avr/lib/avr5 -PROG_PORT = /dev/parport0 - -VERIFY=--verify - -SRC_ARCH = $(PAPARAZZI_SRC)/sw/airborne/arch/avr - -CC = $(ATMELBIN)/avr-gcc -mmcu=$($(TARGET).MCU) -LD = $(CC) $(ATMEL_LIBPATH) -SIZE = $(ATMELBIN)/avr-size -OBJCOPY = $(ATMELBIN)/avr-objcopy - - -SERIAL_FLAGS = \ - -dprog=avr910 \ - -dpart=auto \ - -dserial=/dev/ttyS0 \ - -dspeed=38400 \ - -ISP_FLAGS = \ - -dlpt=$(PROG_PORT) -dprog=stk200 -v=3 \ - -UISP = uisp -UISP_FLAGS = $(ISP_FLAGS) -#UISP_FLAGS = $(SERIAL_FLAGS) - -# Launch with "make Q=''" to get full command display -Q=@ - - -# -# End of configuration part. -# -SRCAVR = $($(TARGET).srcs) - -CFLAGS = \ - -W -Wall -Wundef \ - $(ATMEL_INCLUDES) \ - $(INCLUDES) \ - -Wstrict-prototypes \ - $($(TARGET).CFLAGS) \ - $(LOCAL_CFLAGS) \ - -O3 \ - -LDFLAGS = -lm \ - -# -# General rules -# - -#$(TARGET).srcsnd = $(notdir $($(TARGET).srcs)) -#$(TARGET).objso = $($(TARGET).srcsnd:%.c=$(OBJDIR)/%.o) -#$(TARGET).objs = $($(TARGET).objso:%.S=$(OBJDIR)/%.o) - - -all: build -#all compile: $($(TARGET).objs) $(OBJDIR)/$(TARGET).elf -#all: -# @echo !!!!!!! -# @echo $($(TARGET).objs) -# @echo !!!!!!! - -load upload: $(TARGET).install - - -# -# Fuses -# - -rd_fuses: check_arch - $(UISP) $(ISP_FLAGS) --rd_fuses - -wr_fuses : check_arch - $(UISP) $(ISP_FLAGS) --wr_fuse_h=$($(TARGET).HIGH_FUSE) - $(UISP) $(ISP_FLAGS) --wr_fuse_l=$($(TARGET).LOW_FUSE) - $(UISP) $(ISP_FLAGS) --wr_fuse_e=$($(TARGET).EXT_FUSE) - $(UISP) $(ISP_FLAGS) --wr_lock=$($(TARGET).LOCK_FUSE) - -TMPFILE = '/tmp/check_fuses.tmp' - -check_fuses: check_arch - @echo "##### Check of fuses #####" - @$(UISP) $(ISP_FLAGS) --rd_fuses >$(TMPFILE) - @if (grep -i 'Fuse Low Byte' $(TMPFILE) | cut -c24- | grep -iq $($(TARGET).LOW_FUSE)) && (grep -i 'Fuse High Byte' $(TMPFILE) |cut -c24- | grep -iq $($(TARGET).HIGH_FUSE)) && (grep -i 'Fuse Extended Byte' $(TMPFILE) |cut -c24- | grep -iq $($(TARGET).EXT_FUSE)) && (grep -i 'Lock Bits' $(TMPFILE) |cut -c24- | grep -iq $($(TARGET).LOCK_FUSE)); then echo "-> Fuses are Ok"; rm $(TMPFILE); else echo "-> Wrong fuses. Type 'make wr_fuses'"; rm $(TMPFILE); exit 1; fi - -# Define all object files. -COBJ = $(SRC:%.c=$(OBJDIR)/%.o) -COBJAVR = $(SRCAVR:%.c=$(OBJDIR)/%.o) - - -build: elf hex - -elf: $(OBJDIR)/$(TARGET).elf -hex: $(OBJDIR)/$(TARGET).hex - - -%.hex: %.elf - @echo OBJC $@ - $(OBJCOPY) -O ihex -R .eeprom $< $@ - -.SECONDARY : $(OBJDIR)/$(TARGET).elf -.PRECIOUS : $(COBJ) $(COBJAVR) - -%.elf: $(COBJ) $(COBJAVR) - @echo LD $@ - $(Q)$(LD) $(LOCAL_LDFLAGS) $^ -o $@ $(LDFLAGS) - @echo SIZE - $(Q)$(SIZE) $@ - - -#%.s: %.c -# $(CC) $(CFLAGS) -S -o $@ $< - -#$(OBJDIR)/%.s: %.c -# $(CC) $(CFLAGS) -S -o $@ $< - -$(OBJDIR)/%.o: %.c $(OBJDIR)/../Makefile.ac - @echo CC $@ - $(Q)test -d $(dir $@) || mkdir -p $(dir $@) - $(Q)$(CC) -c $(CFLAGS) $< -o $@ - -#$(OBJDIR)/%.o: $(SRC_ARCH)/%.S -# $(CC) $(CFLAGS) -c -o $@ $< - - - -%.install: $(OBJDIR)/%.hex check_arch -# stk200 needs to be erased first - $(UISP) $(UISP_FLAGS) --erase - @echo SIZE - $(Q)$(SIZE) $< - $(UISP) $(UISP_FLAGS) --upload $(VERIFY) if=$< - -erase: check_arch - $(UISP) $(ISP_FLAGS) --erase - -check_arch : - @echo "CHECKING link with device $($(TARGET).MCU) on $(PROG_PORT)" - $(Q)$(UISP) $(UISP_FLAGS) - $(Q)if ($(UISP) $(UISP_FLAGS) 2>&1 | tr '[:upper:]' '[:lower:]' | grep $($(TARGET).MCU)); then : ; else echo "Wrong architecture (mcu0 vs mcu1 ?)"; exit 1; fi - -avr_clean: - rm -rf $(OBJDIR) - - -# -# Dependencies -# - -$(OBJDIR)/.depend: - @echo DEPEND $@ - @test -d $(OBJDIR) || mkdir -p $(OBJDIR) - $(Q)$(CC) -MM -MG $(CFLAGS) $($(TARGET).srcs) | sed 's|\([^\.]*\.o\)|$(OBJDIR)/\1|' > $@ - -ifneq ($(MAKECMDGOALS),clean) -ifneq ($(MAKECMDGOALS),erase) --include $(OBJDIR)/.depend -endif -endif diff --git a/conf/Makefile.sim b/conf/Makefile.sim index d494e44845..6e892e09e3 100644 --- a/conf/Makefile.sim +++ b/conf/Makefile.sim @@ -27,10 +27,13 @@ # this should not be needed SRC_ARCH = arch/sim +include $(PAPARAZZI_SRC)/sw/Makefile.ocaml + CC = gcc -OCAMLC = ocamlc SIMDIR = $(PAPARAZZI_SRC)/sw/simulator -CAMLINCLUDES = $(shell ocamlfind query -r -i-format lablgtk2) -I $(PAPARAZZI_SRC)/sw/lib/ocaml -I $(SIMDIR) $(shell ocamlfind query -r -i-format xml-light) +CAMLINCLUDES = -I $(LIBPPRZDIR) -I $(SIMDIR) -I $(OBJDIR) +PKG = -package glibivy,pprz +LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz SIMSITLML = $(OBJDIR)/simsitl.ml MYGTKINITCMO = myGtkInit.cmo SITLCMA = $(SIMDIR)/sitl.cma @@ -42,12 +45,20 @@ Q=@ # End of configuration part. # +LBITS := $(shell getconf LONG_BIT) +ifeq ($(LBITS),64) + FPIC = -fPIC +else + FPIC = +endif + INCLUDES += -I `ocamlc -where` CFLAGS = -W -Wall CFLAGS += $(INCLUDES) CFLAGS += $($(TARGET).CFLAGS) CFLAGS += $(LOCAL_CFLAGS) +CFLAGS += $(FPIC) CFLAGS += -O2 CFLAGS += -g CFLAGS += -std=gnu99 @@ -65,10 +76,14 @@ $(TARGET).objs = $($(TARGET).objso:%.S=$(OBJDIR)/%.o) all compile: $(OBJDIR)/simsitl +# shared library of the C autopilot part +autopilot.so : $($(TARGET).objs) + @echo BUILD $@ + $(Q)$(CC) -shared -o $(OBJDIR)/$@ $^ -$(OBJDIR)/simsitl : $($(TARGET).objs) $(SITLCMA) $(SIMSITLML) +$(OBJDIR)/simsitl : autopilot.so $(SITLCMA) $(SIMSITLML) @echo LD $@ - $(Q)$(OCAMLC) -g -custom $(CAMLINCLUDES) -o $@ unix.cma str.cma xml-light.cma glibivy-ocaml.cma lib-pprz.cma lablgtk.cma $($(TARGET).objs) $(MYGTKINITCMO) $(SITLCMA) $(SIMSITLML) + $(Q)$(OCAMLC) -g $(CAMLINCLUDES) -o $@ $(LINKPKG) $(MYGTKINITCMO) $^ -dllpath $(OBJDIR) -dllpath $(SIMDIR) # The id of the A/C is hardcoded in the code (to be improved with dynlink ?) diff --git a/conf/airframes/ENAC/quadrotor/booz2_g1.xml b/conf/airframes/ENAC/quadrotor/booz2_g1.xml index cc8f78e1f7..275f05fe4b 100644 --- a/conf/airframes/ENAC/quadrotor/booz2_g1.xml +++ b/conf/airframes/ENAC/quadrotor/booz2_g1.xml @@ -3,17 +3,17 @@ - + - + @@ -41,9 +41,9 @@ - + diff --git a/conf/airframes/ENAC/quadrotor/hen1.xml b/conf/airframes/ENAC/quadrotor/hen1.xml index 9dfa2c74b8..78b81b8e0b 100644 --- a/conf/airframes/ENAC/quadrotor/hen1.xml +++ b/conf/airframes/ENAC/quadrotor/hen1.xml @@ -3,6 +3,11 @@ + + + + + @@ -29,9 +34,9 @@ - + @@ -163,12 +168,12 @@ - - + + - - + + diff --git a/conf/airframes/esden/gain_scheduling_example.xml b/conf/airframes/esden/gain_scheduling_example.xml index 378238291a..a6e726365b 100644 --- a/conf/airframes/esden/gain_scheduling_example.xml +++ b/conf/airframes/esden/gain_scheduling_example.xml @@ -25,13 +25,13 @@ - + - + - + @@ -63,7 +63,7 @@ - + @@ -83,24 +83,24 @@ - +
- + - + - + @@ -134,7 +134,7 @@ - + @@ -146,7 +146,7 @@ - + @@ -163,7 +163,7 @@ - + @@ -198,7 +198,7 @@ - + @@ -210,8 +210,6 @@ - - diff --git a/conf/airframes/esden/lisa2_hex.xml b/conf/airframes/esden/lisa2_hex.xml index 6b1a8d334a..41d1d67104 100644 --- a/conf/airframes/esden/lisa2_hex.xml +++ b/conf/airframes/esden/lisa2_hex.xml @@ -112,7 +112,7 @@ - + @@ -184,7 +184,7 @@ - + diff --git a/conf/airframes/examples/microjet_lisa_m.xml b/conf/airframes/examples/microjet_lisa_m.xml index 202fe5d999..6ed7c1bed7 100644 --- a/conf/airframes/examples/microjet_lisa_m.xml +++ b/conf/airframes/examples/microjet_lisa_m.xml @@ -20,9 +20,6 @@ - - - diff --git a/conf/airframes/examples/microjet_twog_aspirin.xml b/conf/airframes/examples/microjet_twog_aspirin.xml index 8160835491..c777bc0f44 100644 --- a/conf/airframes/examples/microjet_twog_aspirin.xml +++ b/conf/airframes/examples/microjet_twog_aspirin.xml @@ -26,9 +26,6 @@ - - - diff --git a/conf/airframes/fraser_lisa_m_rotorcraft.xml b/conf/airframes/fraser_lisa_m_rotorcraft.xml index 4c8b7765d2..a232a41767 100644 --- a/conf/airframes/fraser_lisa_m_rotorcraft.xml +++ b/conf/airframes/fraser_lisa_m_rotorcraft.xml @@ -30,9 +30,6 @@ - - - diff --git a/conf/firmwares/rotorcraft.makefile b/conf/firmwares/rotorcraft.makefile index a1d843231e..9dce60427f 100644 --- a/conf/firmwares/rotorcraft.makefile +++ b/conf/firmwares/rotorcraft.makefile @@ -239,7 +239,9 @@ ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_rate.c ap.CFLAGS += -DUSE_NAVIGATION ap.srcs += $(SRC_FIRMWARE)/guidance/guidance_h.c +ap.srcs += $(SRC_FIRMWARE)/guidance/guidance_h_ref.c ap.srcs += $(SRC_FIRMWARE)/guidance/guidance_v.c +ap.srcs += $(SRC_FIRMWARE)/guidance/guidance_v_ref.c # # INS choice diff --git a/conf/firmwares/subsystems/fixedwing/autopilot.makefile b/conf/firmwares/subsystems/fixedwing/autopilot.makefile index 309581e472..f15c206c9f 100644 --- a/conf/firmwares/subsystems/fixedwing/autopilot.makefile +++ b/conf/firmwares/subsystems/fixedwing/autopilot.makefile @@ -234,7 +234,7 @@ endif jsbsim.CFLAGS += $(fbw_CFLAGS) $(ap_CFLAGS) jsbsim.srcs += $(fbw_srcs) $(ap_srcs) -jsbsim.CFLAGS += -DSITL +jsbsim.CFLAGS += -DSITL -DUSE_JSBSIM jsbsim.srcs += $(SIMDIR)/sim_ac_jsbsim.c $(SIMDIR)/sim_ac_fw.c $(SIMDIR)/sim_ac_flightgear.c # external libraries diff --git a/conf/firmwares/subsystems/lisa_passthrough/booz_stabilization_int.makefile b/conf/firmwares/subsystems/lisa_passthrough/booz_stabilization_int.makefile index ece85d0f60..53d7b44202 100644 --- a/conf/firmwares/subsystems/lisa_passthrough/booz_stabilization_int.makefile +++ b/conf/firmwares/subsystems/lisa_passthrough/booz_stabilization_int.makefile @@ -5,7 +5,9 @@ stm_passthrough.srcs += $(SRC_FIRMWARE)/stabilization.c stm_passthrough.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_rate.c stm_passthrough.srcs += $(SRC_FIRMWARE)/guidance/guidance_h.c +stm_passthrough.srcs += $(SRC_FIRMWARE)/guidance/guidance_h_ref.c stm_passthrough.srcs += $(SRC_FIRMWARE)/guidance/guidance_v.c +stm_passthrough.srcs += $(SRC_FIRMWARE)/guidance/guidance_v_ref.c stm_passthrough.CFLAGS += -DUSE_NAVIGATION stm_passthrough.srcs += $(SRC_SUBSYSTEMS)/ins.c diff --git a/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile b/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile index 985f80a937..f4b19af9fa 100644 --- a/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile +++ b/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile @@ -111,42 +111,11 @@ nps.srcs += $(SRC_FIRMWARE)/stabilization.c nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_rate.c nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_none.c - -NUM_TYPE=integer -#NUM_TYPE=float - -STAB_TYPE=euler -#STAB_TYPE=quaternion - -ifeq ($(NUM_TYPE), integer) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_INT - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_int.h\" - ifeq ($(STAB_TYPE), euler) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_euler_int.h\" - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_euler_int.c - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_euler_int.c - else ifeq ($(STAB_TYPE), quaternion) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_int.h\" - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_int.c - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_int.c - endif -else ifeq ($(NUM_TYPE), float) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_FLOAT - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_float.h\" - ifeq ($(STAB_TYPE), euler) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_euler_float.h\" - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_euler_float.c - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_euler_float.c - else ifeq ($(STAB_TYPE), quaternion) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_float.h\" - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_float.c - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_float.c - endif -endif - nps.CFLAGS += -DUSE_NAVIGATION nps.srcs += $(SRC_FIRMWARE)/guidance/guidance_h.c +nps.srcs += $(SRC_FIRMWARE)/guidance/guidance_h_ref.c nps.srcs += $(SRC_FIRMWARE)/guidance/guidance_v.c +nps.srcs += $(SRC_FIRMWARE)/guidance/guidance_v_ref.c # # INS choice diff --git a/conf/firmwares/subsystems/rotorcraft/stabilization_euler.makefile b/conf/firmwares/subsystems/rotorcraft/stabilization_euler.makefile index 3fc38bf53e..e62c41b687 100644 --- a/conf/firmwares/subsystems/rotorcraft/stabilization_euler.makefile +++ b/conf/firmwares/subsystems/rotorcraft/stabilization_euler.makefile @@ -1,5 +1,12 @@ -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_INT -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_int.h\" -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_euler_int.h\" -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_euler_int.c -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_euler_int.c +STAB_ATT_CFLAGS = -DSTABILIZATION_ATTITUDE_TYPE_INT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_int.h\" +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_euler_int.h\" +STAB_ATT_SRCS = $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_euler_int.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_euler_int.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_rc_setpoint.c + +ap.CFLAGS += $(STAB_ATT_CFLAGS) +ap.srcs += $(STAB_ATT_SRCS) + +nps.CFLAGS += $(STAB_ATT_CFLAGS) +nps.srcs += $(STAB_ATT_SRCS) diff --git a/conf/firmwares/subsystems/rotorcraft/stabilization_float_euler.makefile b/conf/firmwares/subsystems/rotorcraft/stabilization_float_euler.makefile new file mode 100644 index 0000000000..4f3b11e76d --- /dev/null +++ b/conf/firmwares/subsystems/rotorcraft/stabilization_float_euler.makefile @@ -0,0 +1,12 @@ +STAB_ATT_CFLAGS = -DSTABILIZATION_ATTITUDE_TYPE_FLOAT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_float.h\" +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_euler_float.h\" +STAB_ATT_SRCS = $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_euler_float.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_euler_float.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_rc_setpoint.c + +ap.CFLAGS += $(STAB_ATT_CFLAGS) +ap.srcs += $(STAB_ATT_SRCS) + +nps.CFLAGS += $(STAB_ATT_CFLAGS) +nps.srcs += $(STAB_ATT_SRCS) diff --git a/conf/firmwares/subsystems/rotorcraft/stabilization_float_quat.makefile b/conf/firmwares/subsystems/rotorcraft/stabilization_float_quat.makefile index 770097569d..ba005a992d 100644 --- a/conf/firmwares/subsystems/rotorcraft/stabilization_float_quat.makefile +++ b/conf/firmwares/subsystems/rotorcraft/stabilization_float_quat.makefile @@ -1,6 +1,13 @@ -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_FLOAT -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_QUAT -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_float.h\" -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_float.h\" -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_float.c -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_float.c +STAB_ATT_CFLAGS = -DSTABILIZATION_ATTITUDE_TYPE_FLOAT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_QUAT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_float.h\" +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_float.h\" +STAB_ATT_SRCS = $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_float.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_float.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_rc_setpoint.c + +ap.CFLAGS += $(STAB_ATT_CFLAGS) +ap.srcs += $(STAB_ATT_SRCS) + +nps.CFLAGS += $(STAB_ATT_CFLAGS) +nps.srcs += $(STAB_ATT_SRCS) diff --git a/conf/firmwares/subsystems/rotorcraft/stabilization_int_quat.makefile b/conf/firmwares/subsystems/rotorcraft/stabilization_int_quat.makefile index 775dc7ce34..10e015f4a2 100644 --- a/conf/firmwares/subsystems/rotorcraft/stabilization_int_quat.makefile +++ b/conf/firmwares/subsystems/rotorcraft/stabilization_int_quat.makefile @@ -1,6 +1,13 @@ -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_INT -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_QUAT -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_int.h\" -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_int.h\" -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_int.c -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_int.c +STAB_ATT_CFLAGS = -DSTABILIZATION_ATTITUDE_TYPE_INT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_QUAT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_int.h\" +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_int.h\" +STAB_ATT_SRCS = $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_int.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_int.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_rc_setpoint.c + +ap.CFLAGS += $(STAB_ATT_CFLAGS) +ap.srcs += $(STAB_ATT_SRCS) + +nps.CFLAGS += $(STAB_ATT_CFLAGS) +nps.srcs += $(STAB_ATT_SRCS) diff --git a/conf/firmwares/subsystems/shared/actuators_mkk_v2.makefile b/conf/firmwares/subsystems/shared/actuators_mkk_v2.makefile index d41b51e140..69198138e9 100644 --- a/conf/firmwares/subsystems/shared/actuators_mkk_v2.makefile +++ b/conf/firmwares/subsystems/shared/actuators_mkk_v2.makefile @@ -4,8 +4,8 @@ # enable the subsystem for your firmware: # # ... -# -# +# +# # # # diff --git a/conf/gps/Makefile b/conf/gps/Makefile index 9cc7e8a4ec..17a823a983 100644 --- a/conf/gps/Makefile +++ b/conf/gps/Makefile @@ -1,11 +1,14 @@ +# Quiet compilation +Q=@ + CC=gcc MODCFLAGS=-Wall all: ublox_conf clean: - rm -f core *.o ublox_conf + $(Q)rm -f core *.o ublox_conf ublox_conf: ublox_conf.c Makefile $(CC) $(MODCFLAGS) ublox_conf.c -o ublox_conf diff --git a/conf/messages.xml b/conf/messages.xml index 473b25cecd..a2d34073b4 100644 --- a/conf/messages.xml +++ b/conf/messages.xml @@ -1496,7 +1496,14 @@ - + + + + + + + + @@ -1815,10 +1822,10 @@ - + - + diff --git a/conf/modules/airspeed_otf.xml b/conf/modules/airspeed_otf.xml new file mode 100644 index 0000000000..6935d2f3a4 --- /dev/null +++ b/conf/modules/airspeed_otf.xml @@ -0,0 +1,31 @@ + + + + + + OTF! airspeed/flow angle sensor + Driver for the Aeroprobe On-The-Fly! air data computer. + + The Aeroprobe On-The-Fly! air data computer measures + air pressure from a 5-hole pitot tube and can write + resulting data to an SD card or transmit it through an + UART. It outputs speed, angle of attack, angle of + sideslip and altitude. + + + +
+ + +
+ + + + + + + + + + + diff --git a/conf/modules/imu_quality_assessment.xml b/conf/modules/imu_quality_assessment.xml index 20c0757b8c..0fc188f789 100644 --- a/conf/modules/imu_quality_assessment.xml +++ b/conf/modules/imu_quality_assessment.xml @@ -2,11 +2,12 @@ - Give comparable with IMU Health information: --saturation information --vibration level --magnetic field hard iron offset - + + Give comparable with IMU Health information. + - saturation information + - vibration level + - magnetic field hard iron offset +
diff --git a/conf/modules/mag_hmc5843.xml b/conf/modules/mag_hmc5843.xml index 9d7ac1b160..329c9257a2 100644 --- a/conf/modules/mag_hmc5843.xml +++ b/conf/modules/mag_hmc5843.xml @@ -12,11 +12,11 @@ - + - - - - + + + + diff --git a/conf/modules/sonar_adc.xml b/conf/modules/sonar_adc.xml index 575812fac2..d477c56c96 100644 --- a/conf/modules/sonar_adc.xml +++ b/conf/modules/sonar_adc.xml @@ -7,8 +7,8 @@ output - Sonar_distance in [m] - - + +
diff --git a/conf/radios/Corona_24_DIY.xml b/conf/radios/Corona_24_DIY.xml index 2872e3f530..e2431114d1 100644 --- a/conf/radios/Corona_24_DIY.xml +++ b/conf/radios/Corona_24_DIY.xml @@ -17,7 +17,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. --> - + True + False window1 32 True + False True + False process name 20 @@ -25,9 +28,15 @@ True True - ● + â— + False + False + True + True + True + True 1 @@ -37,6 +46,7 @@ True False Automatic respawn + False True @@ -55,6 +65,7 @@ True True False + False True @@ -71,6 +82,7 @@ False True False + False True @@ -84,24 +96,32 @@ True + False Paparazzi Center True + False True + False True + False + False _A/C True + False gtk-new True + False + False True True @@ -112,6 +132,8 @@ gtk-delete True + False + False True True @@ -122,6 +144,8 @@ gtk-save True + False + False True True @@ -130,12 +154,15 @@ True + False gtk-quit True + False + False True True @@ -148,14 +175,19 @@ True + False + False Session True + False gtk-new True + False + False True True @@ -165,6 +197,8 @@ gtk-save True + False + False True True @@ -174,6 +208,8 @@ gtk-delete True + False + False True True @@ -186,6 +222,8 @@ True + False + False _Tools True @@ -194,15 +232,20 @@ True + False + False _View True + False gtk-fullscreen True + False + False True True @@ -216,13 +259,18 @@ True + False + False _Help True + False True + False + False _About True @@ -248,20 +296,25 @@ 250 400 True + False True + False True + False 0 True + False 12 True + False @@ -272,6 +325,7 @@ True + False <b>A/C</b> True @@ -281,16 +335,20 @@ + True + True 0 True + False 0 True + False 12 @@ -298,8 +356,12 @@ True ID of the aircraft (number from 1 to 255) 3 - ● + â— 3 + False + False + True + True @@ -307,6 +369,7 @@ True + False <b>id</b> True @@ -316,28 +379,36 @@ + True + True 1 True + False 0 True + False 12 True + False True + False + True + True 0 @@ -348,6 +419,7 @@ True False Color selector + False True @@ -363,6 +435,7 @@ True + False <b>GUI color</b> True @@ -372,12 +445,15 @@ + True + True 2 False + True 0 @@ -391,27 +467,35 @@ True + False True + False True + False 0 True + False 12 True + False 2 True + False ________________ + True + True 0 @@ -422,6 +506,7 @@ True False Browse + False True @@ -437,6 +522,7 @@ True False Launch the GCS editor or a text editor (gedit or EDITOR env variable if set) + False True @@ -452,6 +538,7 @@ True + False <b>Airframe</b> True @@ -462,26 +549,33 @@ False + True 0 True + False 0 True + False 12 True + False True + False _________________ + True + True 0 @@ -491,6 +585,7 @@ True True False + False True @@ -506,6 +601,7 @@ True False Launch a text editor (gedit or EDITOR env variable if set) + False True @@ -521,6 +617,7 @@ True + False <b>Flight plan</b> True @@ -531,20 +628,24 @@ False + True 1 True + False 0 True + False 12 True + False 4 @@ -553,21 +654,26 @@ False + True + True 0 True + False False + True 1 True + False gtk-add @@ -576,6 +682,7 @@ True True Add a settings file + False True True @@ -593,6 +700,7 @@ True True Launch an editor on all the settings file + False True @@ -608,6 +716,7 @@ True True Remove the selected settings file + False True @@ -630,6 +739,7 @@ True + False <b>Settings</b> True @@ -640,26 +750,33 @@ False + True 2 True + False 0 True + False 12 True + False True + False _________________ + True + True 0 @@ -669,6 +786,7 @@ True True False + False True @@ -683,6 +801,7 @@ True True False + False True @@ -698,6 +817,7 @@ True + False <b>Radio</b> True @@ -708,26 +828,33 @@ False + True 3 True + False 0 True + False 12 True + False True + False _________________ + True + True 0 @@ -737,6 +864,7 @@ True True False + False True @@ -751,6 +879,7 @@ True True False + False True @@ -766,6 +895,7 @@ True + False <b>Telemetry</b> True @@ -776,6 +906,7 @@ False + True 4 @@ -785,6 +916,8 @@ + True + True 1 @@ -797,29 +930,35 @@ True + False True + False 3 True + False 1 - True True + False True + False 0 True + False 12 True + False @@ -830,6 +969,7 @@ True + False <b>Target</b> True @@ -839,6 +979,8 @@ + True + True 0 @@ -848,18 +990,22 @@ True False Add a target in the combo list + False True + False 0 0 True + False 2 True + False gtk-add @@ -871,6 +1017,7 @@ True + False New Target True @@ -901,24 +1048,29 @@ True + False True True True False + False True + False 0 0 True + False 2 True + False gtk-clear @@ -930,6 +1082,7 @@ True + False Clean True @@ -957,18 +1110,22 @@ True False Build the selected target of the selected A/C. Warning: Save is required before this action + False True + False 0 0 True + False 2 True + False gtk-convert @@ -980,6 +1137,7 @@ True + False Build True @@ -1007,18 +1165,22 @@ True False Upload into the airborne device (which must be plugged !). + False True + False 0 0 True + False 2 True + False gtk-go-up @@ -1030,6 +1192,7 @@ True + False Upload True @@ -1057,39 +1220,64 @@ 1 + + + print config at build time + True + True + False + Enable configuration messages at build time (PRINT_CONFIG). + False + True + + + True + True + 2 + + + True + True 0 True + False False + True 1 True + False 1 True True + False True + False 0 True + False 12 True + False @@ -1100,6 +1288,7 @@ True + False <b>Session</b> True @@ -1109,6 +1298,8 @@ + True + True 0 @@ -1118,6 +1309,7 @@ True True False + False True @@ -1138,18 +1330,22 @@ True True False + False True + False 0 0 True + False 2 True + False gtk-clear @@ -1161,6 +1357,7 @@ True + False Stop/Remove All Processes True @@ -1183,33 +1380,40 @@ + True + True 2 True + False False + True 3 False + True 0 True + False False + True 1 @@ -1225,6 +1429,8 @@ + True + True 2 @@ -1236,12 +1442,15 @@ + True + True 1 True + False False diff --git a/sw/supervision/paparazzicenter.ml b/sw/supervision/paparazzicenter.ml index cc4b8dc333..b3af7d514e 100644 --- a/sw/supervision/paparazzicenter.ml +++ b/sw/supervision/paparazzicenter.ml @@ -135,7 +135,7 @@ let quit_button_callback = fun gui ac_combo session_combo target_combo () -> Sys.rename Utils.backup_xml_file Utils.conf_xml_file; quit_callback gui ac_combo session_combo target_combo () | 3 -> - ignore (Sys.command (sprintf "tkdiff %s %s" Utils.backup_xml_file Utils.conf_xml_file)); + ignore (Sys.command (sprintf "meld %s %s" Utils.backup_xml_file Utils.conf_xml_file)); question_box () | 1 -> Sys.remove Utils.backup_xml_file; @@ -175,7 +175,7 @@ let () = let rec question_box = fun () -> match GToolbox.question_box ~title:"Backup" ~buttons:["Keep changes"; "Discard changes"; "View changes"] ~default:2 "Configuration changes made during the last session were not saved. ?" with | 2 -> Sys.rename Utils.backup_xml_file Utils.conf_xml_file - | 3 -> ignore (Sys.command (sprintf "tkdiff %s %s" Utils.backup_xml_file Utils.conf_xml_file)); question_box () + | 3 -> ignore (Sys.command (sprintf "meld %s %s" Utils.backup_xml_file Utils.conf_xml_file)); question_box () | _ -> Sys.remove Utils.backup_xml_file in question_box () end; diff --git a/sw/supervision/pc_aircraft.ml b/sw/supervision/pc_aircraft.ml index 6d715d9115..005945ab75 100644 --- a/sw/supervision/pc_aircraft.ml +++ b/sw/supervision/pc_aircraft.ml @@ -384,8 +384,11 @@ let build_handler = fun ~file gui ac_combo (target_combo:Gtk_tools.combo) (log:s try ( let ac_name = Gtk_tools.combo_value ac_combo and target = Gtk_tools.combo_value target_combo in - let target = if target="sim" then target else sprintf "%s.compile" target in - Utils.command ~file gui log ac_name target + let target_cmd = if gui#checkbutton_printconfig#active then + sprintf "PRINT_CONFIG=1 %s.compile" target + else + sprintf "%s.compile" target in + Utils.command ~file gui log ac_name target_cmd ) with _ -> log "ERROR: Nothing to build!!!\n" in ignore (gui#button_build#connect#clicked ~callback); diff --git a/sw/supervision/pc_control_panel.ml b/sw/supervision/pc_control_panel.ml index 5b5d4cf03d..2cbfe9b0cf 100644 --- a/sw/supervision/pc_control_panel.ml +++ b/sw/supervision/pc_control_panel.ml @@ -161,17 +161,21 @@ let supervision = fun ?file gui log (ac_combo : Gtk_tools.combo) (target_combo : run_and_monitor ?file gui log "GCS" "" and run_server = fun args -> run_and_monitor ?file gui log "Server" args - and run_sitl = fun ac_name -> + and choose_and_run_sitl = fun ac_name -> let get_args = fun simtype ac_name -> match simtype with "sim" -> sprintf "-a %s -t %s --boot --norc" ac_name simtype | "jsbsim" -> sprintf "-a %s -t %s" ac_name simtype | "nps" -> sprintf "-a %s -t %s" ac_name simtype - | _ -> sprintf "-a %s" ac_name + | _ -> "none" in let sim_type = get_simtype target_combo in let args = get_args sim_type ac_name in - run_and_monitor ?file gui log "Simulator" args + if args <> "none" then begin + run_and_monitor ?file gui log "Simulator" args; + run_and_monitor ?file gui log "GCS" ""; + run_and_monitor ?file gui log "Server" "-n" + end in (* Sessions *) @@ -219,9 +223,7 @@ let supervision = fun ?file gui log (ac_combo : Gtk_tools.combo) (target_combo : (* Simulations *) let simulation = fun () -> - run_sitl (Gtk_tools.combo_value ac_combo); - run_gcs (); - run_server "-n" in + choose_and_run_sitl (Gtk_tools.combo_value ac_combo) in (* Run session *) let callback = fun () -> diff --git a/sw/tools/Makefile b/sw/tools/Makefile index ec51976748..843326d1e2 100644 --- a/sw/tools/Makefile +++ b/sw/tools/Makefile @@ -22,16 +22,11 @@ # Quiet compilation Q=@ -OCAML=ocaml -OCAMLFIND=ocamlfind -OCAMLC=ocamlc -OCAMLDEP=ocamldep -LIBPPRZDIR=../lib/ocaml -INCLUDES=-I $(LIBPPRZDIR) -# $(shell ocamlfind query -r -i-format xml-light) -#OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format netclient) -#OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring) $(shell ocamlfind query -r -a-format -predicates byte netclient) -LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma +include ../Makefile.ocaml + +INCLUDES = +PKG = -package pprz +LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz all: gen_common.cmo gen_aircraft.out gen_airframe.out gen_messages2.out gen_messages.out gen_ubx.out gen_mtk.out gen_flight_plan.out gen_radio.out gen_periodic.out gen_settings.out gen_xsens.out gen_modules.out gen_autopilot.out gen_abi.out find_free_msg_id.out gen_srtm.out mergelogs @@ -40,37 +35,29 @@ ABS_FP = $(FP_CMO:%=$$PAPARAZZI_SRC/sw/tools/%) gen_flight_plan.out : $(FP_CMO) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -custom -o $@ -package unix,str,xml-light -linkpkg ivy-ocaml.cma lib-pprz.cma $^ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ -gen_srtm.out : gen_srtm.ml gen_common.cmo $(LIBPPRZCMA) - @echo OC $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -custom -o $@ -package unix,str,xml-light,netclient -linkpkg ivy-ocaml.cma lib-pprz.cma $< +gen_srtm.out : gen_srtm.ml + @echo OL $@ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $< -%.out : %.ml gen_common.cmo $(LIBPPRZCMA) - @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -custom -o $@ -package unix,str,xml-light -linkpkg ivy-ocaml.cma lib-pprz.cma gen_common.cmo $< - -# disable this for now and use the compiled bytecode -#@cat ../../pprz_src_test.sh > $@ -#@echo '$(OCAML) -I $$PAPARAZZI_SRC/sw/tools $(OCAMLNETINCLUDES) -I $$PAPARAZZI_SRC/sw/lib/ocaml unix.cma str.cma ivy-ocaml.cma xml-light.cma $(OCAMLNETCMA) lib-pprz.cma gen_common.cmo $$PAPARAZZI_BIN/$< $$*' >> $@ -#@chmod a+x $@ +%.out : %.ml gen_common.cmo + @echo OL $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gen_common.cmo $< %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package xml-light -c $< + $(Q)$(OCAMLC) $(INCLUDES) $(PKG) -c $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package xml-light -c $< - -# dependency on lib-pprz -gen_flight_plan.out gen_srtm.out : $(LIBPPRZCMA) + $(Q)$(OCAMLC) $(INCLUDES) $(PKG) -c $< mergelogs: mergelogs.c gcc mergelogs.c -o mergelogs clean: - rm -f *.cm* *.out *~ .depend fp_parser.ml fp_parser.mli mergelogs + $(Q)rm -f *.cm* *.out *~ .depend fp_parser.ml fp_parser.mli mergelogs .PHONY: all clean diff --git a/sw/tools/find_free_msg_id.ml b/sw/tools/find_free_msg_id.ml index 73d76ca7e4..c0f1b11072 100644 --- a/sw/tools/find_free_msg_id.ml +++ b/sw/tools/find_free_msg_id.ml @@ -46,35 +46,35 @@ let used_messages_id = fun xml -> if Xml.tag xml = "message" then (id_of_message xml) ::ids else List.fold_right - (fun c l -> find_message_ids c l) (Xml.children xml) ids + (fun c l -> find_message_ids c l) (Xml.children xml) ids in - List.map - (fun c -> ((Xml.attrib c "name"), find_message_ids c [])) class_xmls + List.map + (fun c -> ((Xml.attrib c "name"), find_message_ids c [])) class_xmls (* useful to display grouped ids *) let group = fun l -> let gl = ref [] in - try - let s = ref (List.hd l) in - let n = List.length l in - for i=1 to n-1 do - let li = List.nth l i and - li1= List.nth l (i-1) in - if (li - li1 > 1) - then begin - gl := - ( - if !s = li1 - then Printf.sprintf "%d" !s - else Printf.sprintf "%d-%d" !s li1) :: !gl; - s := li; - end - else if i = n -1 - then - gl := (Printf.sprintf "%d-%d" !s li) :: !gl; - done; - List.rev !gl - with Not_found -> [] + try + let s = ref (List.hd l) in + let n = List.length l in + for i=1 to n-1 do + let li = List.nth l i and + li1= List.nth l (i-1) in + if (li - li1 > 1) + then begin + gl := + ( + if !s = li1 + then Printf.sprintf "%d" !s + else Printf.sprintf "%d-%d" !s li1) :: !gl; + s := li; + end + else if i = n -1 + then + gl := (Printf.sprintf "%d-%d" !s li) :: !gl; + done; + List.rev !gl + with Not_found -> [] (* MAIN *) let () = @@ -92,16 +92,16 @@ let () = List.map (fun (c,_) -> if List.mem_assoc c umi then let used = List.assoc c umi in - (c,List.filter (fun i -> not (List.mem i used)) id_list) + (c,List.filter (fun i -> not (List.mem i used)) id_list) else (c,id_list) ) messages in (* print free IDs *) List.iter (fun (c, l) -> - Printf.printf "Class : %s \n" c; + Printf.printf "Class : %s \n" c; (*group l*) - List.iter (fun id -> Printf.printf " %d," id) l; - Printf.printf "\n\n" + List.iter (fun id -> Printf.printf " %d," id) l; + Printf.printf "\n\n" ) free_msg_id diff --git a/sw/tools/fp_proc.ml b/sw/tools/fp_proc.ml index f8b9704c05..13198f60c3 100644 --- a/sw/tools/fp_proc.ml +++ b/sw/tools/fp_proc.ml @@ -29,22 +29,22 @@ module G2D = Geometry_2d open Expr_syntax let rec list_split3 = function - [] -> ([], [], []) +[] -> ([], [], []) | (x,y,z)::l -> - let (rx, ry, rz) = list_split3 l in (x::rx, y::ry, z::rz) + let (rx, ry, rz) = list_split3 l in (x::rx, y::ry, z::rz) let parse_expression = fun s -> let lexbuf = Lexing.from_string s in try Expr_parser.expression Expr_lexer.token lexbuf with - Failure("lexing: empty token") -> - fprintf stderr "Lexing error in '%s': unexpected char: '%c' \n" - s (Lexing.lexeme_char lexbuf 0); - exit 1 - | Parsing.Parse_error -> + Failure("lexing: empty token") -> + fprintf stderr "Lexing error in '%s': unexpected char: '%c' \n" + s (Lexing.lexeme_char lexbuf 0); + exit 1 + | Parsing.Parse_error -> fprintf stderr "Parsing error in '%s', token '%s' ?\n" - s (Lexing.lexeme lexbuf); + s (Lexing.lexeme lexbuf); exit 1 @@ -53,12 +53,12 @@ open Latlong let subst_expression = fun env e -> let rec sub = fun e -> match e with - Ident i -> Ident (try List.assoc i env with Not_found -> i) - | Int _ | Float _ | Field _ -> e - | Call (i, es) -> Call (i, List.map sub es) - | CallOperator (i, es) -> CallOperator (i, List.map sub es) - | Index (i,e) -> Index (i,sub e) - | Deref (e,f) -> Deref (sub e, f) in + Ident i -> Ident (try List.assoc i env with Not_found -> i) + | Int _ | Float _ | Field _ -> e + | Call (i, es) -> Call (i, List.map sub es) + | CallOperator (i, es) -> CallOperator (i, List.map sub es) + | Index (i,e) -> Index (i,sub e) + | Deref (e,f) -> Deref (sub e, f) in sub e @@ -72,9 +72,9 @@ let transform_values = fun attribs_not_modified env attribs -> (fun (a, v) -> let e = parse_expression v in let v' = - if List.mem (String.lowercase a) attribs_not_modified - then v - else transform_expression env e in + if List.mem (String.lowercase a) attribs_not_modified + then v + else transform_expression env e in (a, v')) attribs @@ -83,70 +83,70 @@ let prefix_or_deroute = fun prefix reroutes name attribs -> List.map (fun (a, v) -> let v' = - if String.lowercase a = name then - try List.assoc v reroutes with - Not_found -> prefix v - else v in + if String.lowercase a = name then + try List.assoc v reroutes with + Not_found -> prefix v + else v in (a, v')) attribs let transform_exception = fun prefix reroutes env xml -> match xml with - Xml.Element (tag, attribs, children) -> - assert (children=[]); - let attribs = prefix_or_deroute prefix reroutes "deroute" attribs in - let attribs = transform_values [] env attribs in - Xml.Element (tag, attribs, children) - | _ -> failwith "transform_exception" + Xml.Element (tag, attribs, children) -> + assert (children=[]); + let attribs = prefix_or_deroute prefix reroutes "deroute" attribs in + let attribs = transform_values [] env attribs in + Xml.Element (tag, attribs, children) + | _ -> failwith "transform_exception" let transform_stage = fun prefix reroutes env xml -> let rec tr = fun xml -> match xml with - Xml.Element (tag, attribs, children) -> begin - match String.lowercase tag with - "exception" -> - transform_exception prefix reroutes env xml - | "while" -> - let attribs = transform_values [] env attribs in - Xml.Element (tag, attribs, List.map tr children) - | "heading" -> - assert (children=[]); - let attribs = transform_values ["vmode"] env attribs in - Xml.Element (tag, attribs, children) - | "attitude" -> - let attribs = transform_values ["vmode"] env attribs in - Xml.Element (tag, attribs, children) - | "go" -> - assert (children=[]); - let attribs = transform_values ["wp";"from";"hmode";"vmode"] env attribs in - Xml.Element (tag, attribs, children) - | "xyz" -> - assert (children=[]); - let attribs = transform_values [] env attribs in - Xml.Element (tag, attribs, children) - | "circle" -> - assert (children=[]); - let attribs = transform_values ["wp";"hmode";"vmode"] env attribs in - Xml.Element (tag, attribs, children) - | "eight" -> - let attribs = transform_values ["center";"turn_around";"radius"] env attribs in - Xml.Element (tag, attribs, children) - | "deroute" -> - assert (children=[]); - let attribs = prefix_or_deroute prefix reroutes "block" attribs in - Xml.Element (tag, attribs, children) - | "stay" -> - assert (children=[]); - let attribs = transform_values ["wp"; "vmode"] env attribs in - Xml.Element (tag, attribs, children) - | "call" | "set" -> - let attribs = transform_values [] env attribs in - Xml.Element (tag, attribs, children) - | _ -> failwith (sprintf "Fp_proc: Unexpected tag: '%s'" tag) - end - | _ -> failwith "Fp_proc: Xml.Element expected" + Xml.Element (tag, attribs, children) -> begin + match String.lowercase tag with + "exception" -> + transform_exception prefix reroutes env xml + | "while" -> + let attribs = transform_values [] env attribs in + Xml.Element (tag, attribs, List.map tr children) + | "heading" -> + assert (children=[]); + let attribs = transform_values ["vmode"] env attribs in + Xml.Element (tag, attribs, children) + | "attitude" -> + let attribs = transform_values ["vmode"] env attribs in + Xml.Element (tag, attribs, children) + | "go" -> + assert (children=[]); + let attribs = transform_values ["wp";"from";"hmode";"vmode"] env attribs in + Xml.Element (tag, attribs, children) + | "xyz" -> + assert (children=[]); + let attribs = transform_values [] env attribs in + Xml.Element (tag, attribs, children) + | "circle" -> + assert (children=[]); + let attribs = transform_values ["wp";"hmode";"vmode"] env attribs in + Xml.Element (tag, attribs, children) + | "eight" -> + let attribs = transform_values ["center";"turn_around";"radius"] env attribs in + Xml.Element (tag, attribs, children) + | "deroute" -> + assert (children=[]); + let attribs = prefix_or_deroute prefix reroutes "block" attribs in + Xml.Element (tag, attribs, children) + | "stay" -> + assert (children=[]); + let attribs = transform_values ["wp"; "vmode"] env attribs in + Xml.Element (tag, attribs, children) + | "call" | "set" -> + let attribs = transform_values [] env attribs in + Xml.Element (tag, attribs, children) + | _ -> failwith (sprintf "Fp_proc: Unexpected tag: '%s'" tag) + end + | _ -> failwith "Fp_proc: Xml.Element expected" in tr xml @@ -175,7 +175,7 @@ let get_pc_data = fun tag xml -> try Xml.pcdata (ExtXml.child (ExtXml.child xml tag) "0") with - Not_found -> "" + Not_found -> "" let append_children = fun (tag, new_children) xml -> @@ -194,8 +194,8 @@ let parse_include = fun dir flight_plan include_xml -> let f = let procedure = ExtXml.attrib include_xml "procedure" in try Ocaml_tools.find_file [dir; Env.flight_plans_path] procedure with - Not_found -> - failwith (sprintf "parse_include: %s not found\n" procedure) in + Not_found -> + failwith (sprintf "parse_include: %s not found\n" procedure) in let proc_name = ExtXml.attrib include_xml "name" in let prefix = fun x -> proc_name ^ "." ^ x in @@ -205,20 +205,20 @@ let parse_include = fun dir flight_plan include_xml -> try let proc = ExtXml.parse_file ~noprovedtd:true f in let params = List.filter - (fun x -> ExtXml.tag_is x "param") - (Xml.children proc) in + (fun x -> ExtXml.tag_is x "param") + (Xml.children proc) in (* Build the environment with arguments and default values *) let make_assoc = fun xml -> let name = ExtXml.attrib xml "name" in try - (name, List.assoc name args_assocs) + (name, List.assoc name args_assocs) with - Not_found -> - try - (name, Xml.attrib xml "default_value") - with - _ -> failwith (sprintf "Value required for param '%s' in %s" name (Xml.to_string include_xml)) in + Not_found -> + try + (name, Xml.attrib xml "default_value") + with + _ -> failwith (sprintf "Value required for param '%s' in %s" name (Xml.to_string include_xml)) in let env = List.map make_assoc params in let waypoints = get_children "waypoints" proc @@ -238,21 +238,21 @@ let parse_include = fun dir flight_plan include_xml -> "sectors", sectors] (append_pc_data "header" header flight_plan) with - Failure msg -> fprintf stderr "Error: %s\n" msg; exit 1 + Failure msg -> fprintf stderr "Error: %s\n" msg; exit 1 let replace_children = fun xml new_children_assoc -> Xml.Element (Xml.tag xml, Xml.attribs xml, - List.map - (fun x -> - try - let new_children = List.assoc (Xml.tag x) new_children_assoc in - new_children - with - Not_found -> x - ) - (Xml.children xml)) + List.map + (fun x -> + try + let new_children = List.assoc (Xml.tag x) new_children_assoc in + new_children + with + Not_found -> x + ) + (Xml.children xml)) let process_includes = fun dir xml -> @@ -297,7 +297,7 @@ let replace_wp = fun stage waypoints -> let other_attribs = remove_attribs stage ["wp";"wp_qdr";"wp_dist"] in Xml.Element (Xml.tag stage, ("wp", name)::other_attribs, []) with - _ -> stage + _ -> stage let replace_from = fun stage waypoints -> @@ -311,18 +311,18 @@ let replace_from = fun stage waypoints -> let other_attribs = remove_attribs stage ["from";"from_qdr";"from_dist"] in Xml.Element (Xml.tag stage, ("from", name)::other_attribs, []) with - _ -> stage + _ -> stage let process_stage = fun stage waypoints -> let rec do_it = fun stage -> match String.lowercase (Xml.tag stage) with - "go" | "stay" | "circle" -> - replace_from (replace_wp stage waypoints) waypoints + "go" | "stay" | "circle" -> + replace_from (replace_wp stage waypoints) waypoints - | "while" -> - Xml.Element("while", Xml.attribs stage, List.map do_it (Xml.children stage)) - | _ -> stage in + | "while" -> + Xml.Element("while", Xml.attribs stage, List.map do_it (Xml.children stage)) + | _ -> stage in do_it stage @@ -337,11 +337,11 @@ let process_relative_waypoints = fun xml -> let blocks_list = List.map (fun block -> - let new_children = - List.map - (fun stage -> process_stage stage waypoints_list) - (Xml.children block) in - Xml.Element (Xml.tag block, Xml.attribs block, new_children) + let new_children = + List.map + (fun stage -> process_stage stage waypoints_list) + (Xml.children block) in + Xml.Element (Xml.tag block, Xml.attribs block, new_children) ) blocks_list in @@ -359,14 +359,14 @@ let stage_process_path = fun stage rest -> let waypoints = Str.split regexp_path (ExtXml.attrib stage "wpts") in let attribs = Xml.attribs stage in let rec loop = function - [] -> failwith "Waypoint expected in path stage" - | [wp] -> (* Just go to this single point *) - Xml.Element("go", ("wp", wp)::attribs, [])::rest - | wp1::wp2::ps -> - Xml.Element("go", ["from", wp1; - "hmode","route"; - "wp", wp2]@attribs, []):: - if ps = [] then rest else loop (wp2::ps) in + [] -> failwith "Waypoint expected in path stage" + | [wp] -> (* Just go to this single point *) + Xml.Element("go", ("wp", wp)::attribs, [])::rest + | wp1::wp2::ps -> + Xml.Element("go", ["from", wp1; + "hmode","route"; + "wp", wp2]@attribs, []):: + if ps = [] then rest else loop (wp2::ps) in loop waypoints else stage::rest diff --git a/sw/tools/gen_abi.ml b/sw/tools/gen_abi.ml index f6f05e0bed..2b2eb95a10 100644 --- a/sw/tools/gen_abi.ml +++ b/sw/tools/gen_abi.ml @@ -32,10 +32,10 @@ type field = _name * _type type fields = field list type message = { - name : string; - id : int; - fields : fields - } + name : string; + id : int; + fields : fields +} module Syntax = struct (** Translates a "message" XML element into a value of the 'message' type *) @@ -72,7 +72,7 @@ module Syntax = struct check_single_ids msgs; msgs with - Not_found -> failwith (sprintf "No class '%s' found" class_) + Not_found -> failwith (sprintf "No class '%s' found" class_) end (* module Suntax *) @@ -98,9 +98,9 @@ module Gen_onboard = struct let print_args = fun h fields starter -> let rec args = fun h l -> match l with - [] -> Printf.fprintf h ")" - | [(n,t)] -> Printf.fprintf h "const %s %s)" t n - | (n,t)::l' -> Printf.fprintf h "const %s %s, " t n; args h l' + [] -> Printf.fprintf h ")" + | [(n,t)] -> Printf.fprintf h "const %s %s)" t n + | (n,t)::l' -> Printf.fprintf h "const %s %s, " t n; args h l' in Printf.fprintf h "(%s" starter; args h fields @@ -128,9 +128,9 @@ module Gen_onboard = struct (* print arguments *) let rec args = fun h l -> match l with - [] -> Printf.fprintf h ");\n" - | [(n,_)] -> Printf.fprintf h "%s);\n" n - | (n,_)::l' -> Printf.fprintf h "%s, " n; args h l' + [] -> Printf.fprintf h ");\n" + | [(n,_)] -> Printf.fprintf h "%s);\n" n + | (n,_)::l' -> Printf.fprintf h "%s, " n; args h l' in let name = String.capitalize msg.name in Printf.fprintf h "\nstatic inline void AbiSendMsg%s" name; @@ -196,4 +196,4 @@ let () = Printf.fprintf h "\n#endif // ABI_MESSAGES_H\n" with - Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) + Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) diff --git a/sw/tools/gen_aircraft.ml b/sw/tools/gen_aircraft.ml index 0ffa0a5e72..e82a21c4c9 100644 --- a/sw/tools/gen_aircraft.ml +++ b/sw/tools/gen_aircraft.ml @@ -42,36 +42,36 @@ let check_unique_id_and_name = fun conf -> 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) + 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) (** [get_modules dir xml] - * [dir] is the conf directory for modules, [xml] is the parsed airframe.xml *) + * [dir] is the conf directory for modules, [xml] is the parsed airframe.xml *) (*let get_modules = fun dir xml -> let modules = Gen_common.get_modules_of_airframe xml in - (* build a list (file name, (xml, xml list of flags)) *) +(* build a list (file name, (xml, xml list of flags)) *) let extract = List.map Gen_common.get_full_module_conf modules in - (* return a list of name and a list of pairs (xml, xml list) *) +(* return a list of name and a list of pairs (xml, xml list) *) List.split extract*) (** 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 *) let modules = Gen_common.get_modules_of_airframe xml in @@ -82,10 +82,10 @@ let dump_module_section = fun xml f -> fprintf f "\n# include modules directory for all targets\n"; (* get dir and target list *) let dir_list = Gen_common.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 += -Imodules -Iarch/$(ARCH)/modules\n" target) target_list; -**) + (** + 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 += -Imodules -Iarch/$(ARCH)/modules\n" target) target_list; + **) (** include modules directory for ALL targets and not just the defined ones **) fprintf f "$(TARGET).CFLAGS += -Imodules -Iarch/$(ARCH)/modules\n"; List.iter (fun dir -> let dir_name = (String.uppercase dir)^"_DIR" in fprintf f "%s = modules/%s\n" dir_name dir) dir_list; @@ -100,17 +100,17 @@ let dump_module_section = fun xml f -> fprintf f "\n# makefile for module %s in modules/%s\n" name dir; List.iter (fun flag -> match String.lowercase (Xml.tag flag) with - "configure" -> - let value = Xml.attrib flag "value" - and name = Xml.attrib flag "name" in - fprintf f "%s = %s\n" name value - | "define" -> + "configure" -> + let value = Xml.attrib flag "value" + and name = Xml.attrib flag "name" in + fprintf f "%s = %s\n" name value + | "define" -> 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 - | _ -> () + | _ -> () ) m.param; (* Look for makefile section *) List.iter (fun l -> @@ -122,11 +122,11 @@ let dump_module_section = fun xml f -> (* Look for defines, flags, files, ... *) List.iter (fun field -> match String.lowercase (Xml.tag field) with - "configure" -> - let value = Xml.attrib field "value" - and name = Xml.attrib field "name" in - fprintf f "%s = %s\n" name value - | "define" -> + "configure" -> + let value = Xml.attrib field "value" + and name = Xml.attrib field "name" in + fprintf f "%s = %s\n" name value + | "define" -> List.iter (fun target -> let value = try "="^(Xml.attrib field "value") with _ -> "" and name = Xml.attrib field "name" in @@ -135,48 +135,48 @@ let dump_module_section = fun xml f -> | "include" | "I" -> "I" | _ -> "D" in fprintf f "%s.CFLAGS += -%s%s%s\n" target flag_type name value - ) targets - | "file" -> + ) targets + | "file" -> let name = Xml.attrib field "name" in let dir_name = ExtXml.attrib_or_default field "dir" ("$("^dir_name^")") in List.iter (fun target -> fprintf f "%s.srcs += %s/%s\n" target dir_name name) targets - | "file_arch" -> + | "file_arch" -> let name = Xml.attrib field "name" in let dir_name = ExtXml.attrib_or_default field "dir" ("$("^dir_name^")") in List.iter (fun target -> fprintf f "%s.srcs += arch/$(ARCH)/%s/%s\n" target dir_name name) targets - | "raw" -> + | "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 + [Xml.PCData s] -> fprintf f "%s\n" s + | _ -> fprintf stderr "Warning: wrong makefile section in module '%s'\n" name end - | _ -> () - ) (Xml.children l) + | _ -> () + ) (Xml.children l) end) (Xml.children m.xml) - ) modules; + ) modules; (** returns a list of modules file name *) List.map (fun m -> m.file) modules (** - 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 -> if ExtXml.tag_is x "makefile" then begin let loc = ExtXml.attrib_or_default x "location" "before" in match (location, loc) with - ("before", "before") | ("after", "after") -> - fprintf makefile_ac "\n# raw makefile\n"; - begin match Xml.children x with - [Xml.PCData s] -> fprintf makefile_ac "%s\n" s - | _ -> failwith (sprintf "Warning: wrong makefile section in '%s': %s\n" airframe_infile (Xml.to_string_fmt x)) - end - | (_, _) -> () + ("before", "before") | ("after", "after") -> + fprintf makefile_ac "\n# raw makefile\n"; + begin match Xml.children x with + [Xml.PCData s] -> fprintf makefile_ac "%s\n" s + | _ -> failwith (sprintf "Warning: wrong makefile section in '%s': %s\n" airframe_infile (Xml.to_string_fmt x)) + end + | (_, _) -> () end) - (Xml.children xml) + (Xml.children xml) (** - * Firmware Children - * **) + * Firmware Children + * **) (* print a configure (firmware) *) let print_firmware_configure = fun f p -> @@ -248,7 +248,7 @@ let parse_firmware = fun makefile_ac firmware -> (** Search and dump the firmware section - **) +**) let dump_firmware_sections = fun xml makefile_ac -> List.iter (fun tag -> if ExtXml.tag_is tag "firmware" then begin @@ -259,7 +259,7 @@ let dump_firmware_sections = fun xml makefile_ac -> parse_firmware makefile_ac tag with _ -> failwith "Warning: firmware name is undeclared" end) - (Xml.children xml) + (Xml.children xml) @@ -287,13 +287,13 @@ let extract_makefile = fun airframe_file makefile_ac -> 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 - loop dep_files + 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 + loop dep_files let make_element = fun t a c -> Xml.Element (t,a,c) @@ -309,9 +309,9 @@ let () = check_unique_id_and_name conf; let aircraft_xml = try - ExtXml.child conf ~select:(fun x -> Xml.attrib x "name" = aircraft) "aircraft" + 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) + Not_found -> failwith (sprintf "Aircraft '%s' not found in '%s'" aircraft conf_xml) in let value = fun attrib -> ExtXml.attrib aircraft_xml attrib in @@ -333,17 +333,17 @@ let () = 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 + _ -> + 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 + "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); @@ -354,19 +354,19 @@ let () = 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; + && 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; + 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 @@ -379,20 +379,20 @@ let () = 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 + 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 + 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) + let value = Xml.attrib aircraft_xml attr in + make target (sprintf "%s=%s" var value) with - Xml.No_attribute _ -> () in + Xml.No_attribute _ -> () in let temp_makefile_ac = Filename.temp_file "Makefile.ac" "tmp" in let abs_airframe_file = paparazzi_conf // airframe_file in @@ -411,6 +411,6 @@ let () = 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 f0998578c3..543199b8ff 100644 --- a/sw/tools/gen_airframe.ml +++ b/sw/tools/gen_airframe.ml @@ -39,7 +39,7 @@ let get_servo_driver = fun servo_name -> try Hashtbl.find servos_drivers servo_name with - Not_found -> failwith (sprintf "gen_airframe, Unknown servo: %s" servo_name) + Not_found -> failwith (sprintf "gen_airframe, Unknown servo: %s" servo_name) let get_list_of_drivers = fun () -> let l = ref [] in Hashtbl.iter @@ -52,10 +52,10 @@ let define_macro name n x = let a = fun s -> ExtXml.attrib x s in printf "#define %s(" name; match n with (* Do we really need more ??? *) - 1 -> printf "x1) (%s*(x1))\n" (a "coeff1") - | 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" + 1 -> printf "x1) (%s*(x1))\n" (a "coeff1") + | 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 @@ -84,9 +84,9 @@ let convert_value_with_code_unit_coef_of_xml = function xml -> let cu = ExtXml.attrib_or_default xml "code_unit" "" in (* default value for code_unit is rad[/s] when unit is deg[/s] *) let conv = try (Pprz.scale_of_units u cu) with - | Pprz.Unit_conversion_error s -> prerr_endline (sprintf "Unit conversion error: %s" s); flush stderr; exit 1 - | Pprz.Unknown_conversion (su, scu) -> prerr_endline (sprintf "Warning: unknown unit conversion: from %s to %s" su scu); flush stderr; failwith "Unknown unit conversion" - | Pprz.No_automatic_conversion _ | _ -> failwith "Unit conversion error" in + | Pprz.Unit_conversion_error s -> prerr_endline (sprintf "Unit conversion error: %s" s); flush stderr; exit 1 + | Pprz.Unknown_conversion (su, scu) -> prerr_endline (sprintf "Warning: unknown unit conversion: from %s to %s" su scu); flush stderr; failwith "Unknown unit conversion" + | Pprz.No_automatic_conversion _ | _ -> failwith "Unit conversion error" in let v = try ExtXml.float_attrib xml "value" with _ -> prerr_endline (sprintf "Error: Unit conversion of parameter %s impossible because '%s' is not a float" (Xml.attrib xml "name") (Xml.attrib xml "value")); flush stderr; exit 1 in v *. conv @@ -168,74 +168,74 @@ let print_actuators_idx = fun () -> let parse_command_laws = fun command -> let a = fun s -> ExtXml.attrib command s in - match Xml.tag command with - "set" -> - let servo = a "servo" - and value = a "value" in - let v = preprocess_value value "values" "COMMAND" in - printf " command_value = %s; \\\n" v; - printf " command_value *= command_value>0 ? SERVO_%s_TRAVEL_UP_NUM : SERVO_%s_TRAVEL_DOWN_NUM; \\\n" servo servo; - printf " command_value /= command_value>0 ? SERVO_%s_TRAVEL_UP_DEN : SERVO_%s_TRAVEL_DOWN_DEN; \\\n" servo servo; - printf " servo_value = SERVO_%s_NEUTRAL + command_value; \\\n" servo; - printf " Set_%s_Servo(servo_value); \\\n\\\n" servo - | "let" -> - 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 - | "call" -> - let f = a "fun" in - printf " %s; \\\n\\\n" f - | "ratelimit" -> - let var = a "var" - and value = a "value" - and rate_min = a "rate_min" - and rate_max = a "rate_max" in - let v = preprocess_value value "values" "COMMAND" in - printf " static int16_t _var_%s = 0; _var_%s += Chop((%s) - (_var_%s), (%s), (%s)); \\\n" var var v var rate_min rate_max - | "define" -> - parse_element "" command - | _ -> xml_error "set|let" + match Xml.tag command with + "set" -> + let servo = a "servo" + and value = a "value" in + let v = preprocess_value value "values" "COMMAND" in + printf " command_value = %s; \\\n" v; + printf " command_value *= command_value>0 ? SERVO_%s_TRAVEL_UP_NUM : SERVO_%s_TRAVEL_DOWN_NUM; \\\n" servo servo; + printf " command_value /= command_value>0 ? SERVO_%s_TRAVEL_UP_DEN : SERVO_%s_TRAVEL_DOWN_DEN; \\\n" servo servo; + printf " servo_value = SERVO_%s_NEUTRAL + command_value; \\\n" servo; + printf " Set_%s_Servo(servo_value); \\\n\\\n" servo + | "let" -> + 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 + | "call" -> + let f = a "fun" in + printf " %s; \\\n\\\n" f + | "ratelimit" -> + let var = a "var" + and value = a "value" + and rate_min = a "rate_min" + and rate_max = a "rate_max" in + let v = preprocess_value value "values" "COMMAND" in + printf " static int16_t _var_%s = 0; _var_%s += Chop((%s) - (_var_%s), (%s), (%s)); \\\n" var var v var rate_min rate_max + | "define" -> + parse_element "" command + | _ -> xml_error "set|let" let parse_rc_commands = fun rc -> let a = fun s -> ExtXml.attrib rc s in match Xml.tag rc with - "set" -> - let com = a "command" + "set" -> + let com = a "command" + and value = a "value" in + let v = preprocess_value value "_rc_array" "RADIO" in + printf " _commands_array[COMMAND_%s] = %s;\\\n" com v; + | "let" -> + let var = a "var" and value = a "value" in - let v = preprocess_value value "_rc_array" "RADIO" in - printf " _commands_array[COMMAND_%s] = %s;\\\n" com v; - | "let" -> - 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 - | "define" -> - parse_element "" rc - | _ -> xml_error "set|let" + let v = preprocess_value value "rc_values" "RADIO" in + printf " int16_t _var_%s = %s;\\\n" var v + | "define" -> + parse_element "" rc + | _ -> xml_error "set|let" let parse_ap_only_commands = fun ap_only -> let a = fun s -> ExtXml.attrib ap_only s in match Xml.tag ap_only with - "copy" -> - let com = a "command" in - printf " commands[COMMAND_%s] = ap_commands[COMMAND_%s];\\\n" com com - | _ -> xml_error "copy" + "copy" -> + let com = a "command" in + printf " commands[COMMAND_%s] = ap_commands[COMMAND_%s];\\\n" com com + | _ -> xml_error "copy" let parse_command = fun command no -> - let command_name = "COMMAND_"^ExtXml.attrib command "name" in - define command_name (string_of_int no); - let failsafe_value = int_of_string (ExtXml.attrib command "failsafe_value") in - { failsafe_value = failsafe_value; foo = 0} + let command_name = "COMMAND_"^ExtXml.attrib command "name" in + define command_name (string_of_int no); + let failsafe_value = int_of_string (ExtXml.attrib command "failsafe_value") in + { failsafe_value = failsafe_value; foo = 0} let rec parse_section = fun s -> match Xml.tag s with - "section" -> - let prefix = ExtXml.attrib_or_default s "prefix" "" in - define ("SECTION_"^ExtXml.attrib s "name") "1"; - List.iter (parse_element prefix) (Xml.children s); - nl () - | "servos" -> + "section" -> + let prefix = ExtXml.attrib_or_default s "prefix" "" in + define ("SECTION_"^ExtXml.attrib s "name") "1"; + List.iter (parse_element prefix) (Xml.children s); + nl () + | "servos" -> let driver = ExtXml.attrib_or_default s "driver" "Default" in let servos = Xml.children s in let nb_servos = List.fold_right (fun s m -> Pervasives.max (int_of_string (ExtXml.attrib s "no")) m) servos min_int + 1 in @@ -245,25 +245,25 @@ let rec parse_section = fun s -> nl (); List.iter (parse_servo driver) servos; nl () - | "commands" -> + | "commands" -> let commands = Array.of_list (Xml.children s) in let commands_params = Array.mapi (fun i c -> parse_command c i) commands in define "COMMANDS_NB" (string_of_int (Array.length commands)); define "COMMANDS_FAILSAFE" (sprint_float_array (List.map (fun x -> string_of_int x.failsafe_value) (Array.to_list commands_params))); nl (); nl () - | "rc_commands" -> + | "rc_commands" -> printf "#define SetCommandsFromRC(_commands_array, _rc_array) { \\\n"; List.iter parse_rc_commands (Xml.children s); printf "}\n\n" - | "auto_rc_commands" -> + | "auto_rc_commands" -> printf "#define SetAutoCommandsFromRC(_commands_array, _rc_array) { \\\n"; List.iter parse_rc_commands (Xml.children s); printf "}\n\n" - | "ap_only_commands" -> + | "ap_only_commands" -> printf "#define SetApOnlyCommands(ap_commands) { \\\n"; List.iter parse_ap_only_commands (Xml.children s); printf "}\n\n" - | "command_laws" -> + | "command_laws" -> print_actuators_idx (); printf "#define SetActuatorsFromCommands(values) { \\\n"; @@ -279,16 +279,16 @@ let rec parse_section = fun s -> printf "#define AllActuatorsInit() { \\\n"; List.iter (fun d -> printf " Actuators%sInit();\\\n" d) drivers; printf "}\n\n"; - | "include" -> + | "include" -> let filename = ExtXml.attrib s "href" in let subxml = Xml.parse_file filename in printf "/* XML %s */" filename; nl (); List.iter parse_section (Xml.children subxml) - | "makefile" -> + | "makefile" -> () - (** Ignoring this section *) - | _ -> () + (** Ignoring this section *) + | _ -> () let h_name = "AIRFRAME_H" @@ -301,7 +301,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 @@ -322,7 +322,7 @@ let _ = List.iter parse_section (Xml.children xml); finish h_name with - Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 - | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 - | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 - | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 + Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 + | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 + | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 + | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 diff --git a/sw/tools/gen_autopilot.ml b/sw/tools/gen_autopilot.ml index 40b7cb604d..4001d4bdaf 100644 --- a/sw/tools/gen_autopilot.ml +++ b/sw/tools/gen_autopilot.ml @@ -22,7 +22,7 @@ (* * XML preprocessing for core autopilot - *) + *) open Printf open Xml2h @@ -67,8 +67,8 @@ let print_modes = fun modes out_h -> lprintf out_h "#define %s %d\n" (print_mode_name name) !mode_idx; mode_idx := !mode_idx + 1; with _ -> () - ) - modes + ) + modes (** Init function: set last_mode to initial ap_mode *) (* TODO really needed ? *) let print_ap_init = fun modes out_h -> @@ -78,9 +78,9 @@ let print_ap_init = fun modes out_h -> List.exists (fun s -> if Xml.tag s = "select" then Xml.attrib s "cond" = "$DEFAULT_MODE" else false) (Xml.children m) ) modes in match List.length default with - 0 -> List.hd modes - | 1 -> List.hd default - | _ -> failwith "Autopilot Core Error: only one default mode can be set" + 0 -> List.hd modes + | 1 -> List.hd default + | _ -> failwith "Autopilot Core Error: only one default mode can be set" in let default = find_default_mode () in @@ -101,13 +101,13 @@ let print_test_select = fun modes out_h -> List.iter (fun s -> (* In each mode, build condition and exceptions' list *) let cond = Xml.attrib s "cond" in let except = try String.concat " || " - (List.map (fun e -> Printf.sprintf "private_autopilot_mode != %s" (print_mode_name e)) - (Str.split (Str.regexp "|") (Xml.attrib s "exception")) - ) with _ -> "" in + (List.map (fun e -> Printf.sprintf "private_autopilot_mode != %s" (print_mode_name e)) + (Str.split (Str.regexp "|") (Xml.attrib s "exception")) + ) with _ -> "" in match (cond, String.length except) with - ("$DEFAULT_MODE", _) -> () - | (_, 0) -> lprintf out_h "if (%s) { return %s; }\n" cond (print_mode_name (Xml.attrib m "name")) - | (_, _) -> lprintf out_h "if ((%s) && (%s)) { return %s; }\n" cond except (print_mode_name (Xml.attrib m "name")) + ("$DEFAULT_MODE", _) -> () + | (_, 0) -> lprintf out_h "if (%s) { return %s; }\n" cond (print_mode_name (Xml.attrib m "name")) + | (_, _) -> lprintf out_h "if ((%s) && (%s)) { return %s; }\n" cond except (print_mode_name (Xml.attrib m "name")) ) select; ) modes; lprintf out_h "return private_autopilot_mode;\n"; @@ -116,16 +116,16 @@ let print_test_select = fun modes out_h -> (** Function to test exceptions on modes - * The generated function returns the new mode if an exception is true - *) + * The generated function returns the new mode if an exception is true +*) let print_test_exception = fun modes out_h -> (** Test condition and deroute to given mode or last mode *) let print_exception = fun ex -> let name = Xml.attrib ex "deroute" and cond = Xml.attrib ex "cond" in match name with - "$LAST_MODE" -> lprintf out_h "if (%s) { return last_autopilot_mode; }\n" cond - | _ -> lprintf out_h "if (%s) { return %s; }\n" cond (print_mode_name name) + "$LAST_MODE" -> lprintf out_h "if (%s) { return last_autopilot_mode; }\n" cond + | _ -> lprintf out_h "if (%s) { return %s; }\n" cond (print_mode_name name) in lprintf out_h "\nstatic inline uint8_t autopilot_core_mode_exceptions(uint8_t mode) {\n"; @@ -153,8 +153,8 @@ let print_test_exception = fun modes out_h -> lprintf out_h "}\n" (** Function to test global exceptions - * The generated function returns the mode of the last true exception in the list - *) + * The generated function returns the mode of the last true exception in the list +*) let print_global_exceptions = fun exceptions out_h -> lprintf out_h "\nstatic inline uint8_t autopilot_core_global_exceptions(uint8_t mode) {\n"; right (); @@ -206,12 +206,12 @@ let print_set_mode = fun modes out_h -> (** Peridiodic function: calls control loops according to the ap_mode *) let print_ap_periodic = fun modes ctrl_block main_freq out_h -> - (** Print function *) + (** Print function *) let print_call = fun call -> try let f = Xml.attrib call "fun" in let cond = try String.concat "" ["if ("; (Xml.attrib call "cond"); ") { "; f; "; }\n"] - with _ -> String.concat "" [f; ";\n"] in + with _ -> String.concat "" [f; ";\n"] in lprintf out_h "%s" cond with _ -> () in @@ -219,9 +219,9 @@ let print_ap_periodic = fun modes ctrl_block main_freq out_h -> let print_ctrl = fun ctrl -> List.iter (fun c -> match (Xml.tag c) with - "call" -> print_call c - | "call_block" -> List.iter print_call (Xml.children (List.find (fun n -> (Xml.attrib c "name") = (Xml.attrib n "name")) ctrl_block)) - | _ -> () + "call" -> print_call c + | "call_block" -> List.iter print_call (Xml.children (List.find (fun n -> (Xml.attrib c "name") = (Xml.attrib n "name")) ctrl_block)) + | _ -> () ) (Xml.children ctrl) in (** Equivalent to the RunOnceEvery macro *) @@ -261,9 +261,9 @@ let print_ap_periodic = fun modes ctrl_block main_freq out_h -> let ctrl_freq = try int_of_string (Xml.attrib c "freq") with _ -> main_freq in let prescaler = main_freq / ctrl_freq in match prescaler with - 0 -> failwith "Autopilot Core Error: control freq higher than main freq" - | 1 -> print_ctrl c (* no prescaler if running at main_freq *) - | _ -> print_prescaler prescaler c + 0 -> failwith "Autopilot Core Error: control freq higher than main freq" + | 1 -> print_ctrl c (* no prescaler if running at main_freq *) + | _ -> print_prescaler prescaler c ) (get_control m); left (); lprintf out_h "}\n"; @@ -296,16 +296,16 @@ let parse_modes ap freq out_h = let h_name = "AUTOPILOT_CORE_H" (** Main generation function - * Usage: main_freq xml_file_input h_file_output - *) + * Usage: main_freq xml_file_input h_file_output +*) let gen_autopilot main_freq xml_file h_file = let out_h = open_out h_file in try let ap_xml = start_and_begin_out xml_file h_name out_h in let _ = try - let ap_name = Xml.attrib ap_xml "name" in - fprintf out_h "/*** %s ***/\n\n" ap_name; - with _ -> () in + let ap_name = Xml.attrib ap_xml "name" in + fprintf out_h "/*** %s ***/\n\n" ap_name; + with _ -> () in fprintf out_h "#ifdef AUTOPILOT_CORE_C\n"; fprintf out_h "#define EXTERN_AP\n"; fprintf out_h "#else\n"; @@ -315,10 +315,10 @@ let gen_autopilot main_freq xml_file h_file = fprintf out_h "\n#endif // %s\n" h_name; close_out out_h with - Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 - | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 - | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 - | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 + Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 + | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 + | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 + | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 (* Main call *) let () = @@ -332,14 +332,12 @@ let () = gen_autopilot ap_freq autopilot h_file; () with - Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 - | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 - | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 - | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 - | Not_found -> + Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 + | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 + | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 + | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 + | Not_found -> let out_h = open_out h_file in fprintf out_h "/*** Sorry, no autopilot file found ***/\n"; close_out out_h; exit 0 - - diff --git a/sw/tools/gen_common.ml b/sw/tools/gen_common.ml index 2d5a821dc8..54ede59123 100644 --- a/sw/tools/gen_common.ml +++ b/sw/tools/gen_common.ml @@ -39,9 +39,9 @@ let default_freq = 60 let singletonize = fun l -> let rec loop = fun l -> match l with - [] | [_] -> l - | x::((x'::_) as xs) -> - if x = x' then loop xs else x::loop xs in + [] | [_] -> l + | x::((x'::_) as xs) -> + if x = x' then loop xs else x::loop xs in loop (List.sort compare l) (** union of two lists *) @@ -56,75 +56,75 @@ let union_of_lists = fun l -> singletonize sl (** [targets_of_field] - * Returns the targets of a makefile node in modules - * Default "ap|sim" *) + * Returns the targets of a makefile node in modules + * Default "ap|sim" *) let pipe_regexp = Str.regexp "|" let targets_of_field = fun field default -> try Str.split pipe_regexp (ExtXml.attrib_or_default field "target" default) with - _ -> [] + _ -> [] (** [get_autopilot_of_airframe xml] - * Returns (autopilot xml, main freq) from airframe xml file *) + * Returns (autopilot xml, main freq) from airframe xml file *) let get_autopilot_of_airframe = fun xml -> (* extract all "modules" sections *) let section = List.filter (fun s -> compare (Xml.tag s) "autopilot" = 0) (Xml.children xml) in (* Raise error if more than one modules section *) match section with - [autopilot] -> - let freq = try int_of_string (Xml.attrib autopilot "freq") with _ -> default_freq in - let ap = try Xml.attrib autopilot "name" with _ -> raise Not_found in - (autopilot_dir // ap, freq) - | [] -> raise Not_found - | _ -> failwith "Error: you have more than one 'autopilot' section in your airframe file" + [autopilot] -> + let freq = try int_of_string (Xml.attrib autopilot "freq") with _ -> default_freq in + let ap = try Xml.attrib autopilot "name" with _ -> raise Not_found in + (autopilot_dir // ap, freq) + | [] -> raise Not_found + | _ -> failwith "Error: you have more than one 'autopilot' section in your airframe file" (** [get_modules_of_airframe xml] - * Returns a list of module configuration from airframe file *) + * Returns a list of module configuration from airframe file *) let rec get_modules_of_airframe = fun xml -> (* extract all "modules" sections *) let section = List.filter (fun s -> compare (Xml.tag s) "modules" = 0) (Xml.children xml) in (* get autopilot file if any *) let ap_file = try - let (ap, _) = get_autopilot_of_airframe xml in - ap - with _ -> "" in + let (ap, _) = get_autopilot_of_airframe xml in + ap + with _ -> "" in (* Raise error if more than one modules section *) match section with - [modules] -> + [modules] -> (* if only one section, returns a list of configuration *) - let t_global = targets_of_field modules "" in - let get_module = fun m t -> - let file = modules_dir // ExtXml.attrib m "name" in - let targets = singletonize (t @ targets_of_field m "") in - { xml = ExtXml.parse_file file; file = file; param = Xml.children m; extra_targets = targets } - in - let modules_list = List.map (fun m -> - if compare (Xml.tag m) "load" <> 0 then Xml2h.xml_error "load"; - get_module m t_global - ) (Xml.children modules) in - let ap_modules = try - get_modules_of_airframe (ExtXml.parse_file ap_file) - with _ -> [] in - modules_list @ ap_modules - | [] -> [] - | _ -> failwith "Error: you have more than one 'modules' section in your airframe file" + let t_global = targets_of_field modules "" in + let get_module = fun m t -> + let file = modules_dir // ExtXml.attrib m "name" in + let targets = singletonize (t @ targets_of_field m "") in + { xml = ExtXml.parse_file file; file = file; param = Xml.children m; extra_targets = targets } + in + let modules_list = List.map (fun m -> + if compare (Xml.tag m) "load" <> 0 then Xml2h.xml_error "load"; + get_module m t_global + ) (Xml.children modules) in + let ap_modules = try + get_modules_of_airframe (ExtXml.parse_file ap_file) + with _ -> [] in + modules_list @ ap_modules + | [] -> [] + | _ -> failwith "Error: you have more than one 'modules' section in your airframe file" (** [get_targets_of_module xml] - * Returns the list of targets of a module *) + * Returns the list of targets of a module *) let get_targets_of_module = fun conf -> let targets = List.map (fun x -> match String.lowercase (Xml.tag x) with - "makefile" -> targets_of_field x default_module_targets - | _ -> [] + "makefile" -> targets_of_field x default_module_targets + | _ -> [] ) (Xml.children conf.xml) in let targets = (List.flatten targets) @ conf.extra_targets in (* return a singletonized list *) singletonize (List.sort compare targets) (** [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 *) + * 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 -> @@ -139,7 +139,7 @@ let unload_unused_modules = fun modules print_error -> List.find_all is_target_in_module modules (** [get_modules_name xml] - * Returns a list of loaded modules' name *) + * Returns a list of loaded modules' name *) let get_modules_name = fun xml -> (* extract all "modules" sections *) let modules = get_modules_of_airframe xml in @@ -149,7 +149,7 @@ let get_modules_name = fun xml -> List.map (fun m -> ExtXml.attrib m.xml "name") modules (** [get_modules_dir xml] - * Returns the list of modules directories *) + * Returns the list of modules directories *) let get_modules_dir = fun modules -> let dir = List.map (fun m -> try Xml.attrib m.xml "dir" with _ -> ExtXml.attrib m.xml "name") modules in singletonize (List.sort compare dir) diff --git a/sw/tools/gen_flight_plan.ml b/sw/tools/gen_flight_plan.ml index ecc2d66cd4..cdcdad33ac 100644 --- a/sw/tools/gen_flight_plan.ml +++ b/sw/tools/gen_flight_plan.ml @@ -48,11 +48,11 @@ 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_ident x -> unexpected "ident" x - | Expr_syntax.Unknown_function x -> unexpected "function" 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 end; Expr_syntax.sprint e @@ -80,8 +80,8 @@ let float_attrib = fun xml a -> try float_of_string (Xml.attrib xml a) with - Failure "float_of_string" -> - failwith (sprintf "Float expected in attribute '%s' from %s" a (Xml.to_string_fmt xml)) + Failure "float_of_string" -> + failwith (sprintf "Float expected in attribute '%s' from %s" a (Xml.to_string_fmt xml)) let name_of = fun wp -> ExtXml.attrib wp "name" @@ -99,14 +99,14 @@ 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 - Xml.No_attribute "lat" | Xml.No_attribute "lon" -> - waypoint + Xml.No_attribute "lat" | Xml.No_attribute "lon" -> + waypoint let print_waypoint = fun default_alt waypoint -> @@ -132,7 +132,7 @@ let get_index_block = fun x -> try List.assoc x !index_of_blocks with - Not_found -> failwith (sprintf "Unknown block: '%s'" x) + Not_found -> failwith (sprintf "Unknown block: '%s'" x) let print_exception = fun x -> let i = get_index_block (ExtXml.attrib x "deroute") in @@ -152,16 +152,16 @@ let get_index_waypoint = fun x l -> try string_of_int (List.assoc x l) with - Not_found -> failwith (sprintf "Unknown waypoint: %s" x) + Not_found -> failwith (sprintf "Unknown waypoint: %s" x) let pprz_throttle = fun s -> begin 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 *) + Failure "float_of_string" -> () (* No possible check on expression *) end; sprintf "9600*(%s)" s @@ -178,44 +178,44 @@ let output_vmode = fun stage_xml wp last_wp -> let vmode = try ExtXml.attrib stage_xml "vmode" with _ -> "alt" in begin match vmode with - "climb" -> - lprintf "NavVerticalClimbMode(%s);\n" (parsed_attrib stage_xml "climb") - | "alt" -> - let alt = - try - let a = parsed_attrib stage_xml "alt" in - begin + "climb" -> + lprintf "NavVerticalClimbMode(%s);\n" (parsed_attrib stage_xml "climb") + | "alt" -> + let alt = try - check_altitude (float_of_string a) stage_xml - with + 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 - try - check_altitude ((float_of_string h) +. !ground_alt) stage_xml - with + Failure "float_of_string" -> () + end; + a + with _ -> + try + let h = parsed_attrib stage_xml "height" in + begin + try + check_altitude ((float_of_string h) +. !ground_alt) stage_xml + with (* Impossible to check the altitude on an expression: *) - Failure "float_of_string" -> () - end; - 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; - | "xyz" -> () (** Handled in Goto3D() *) - | "glide" -> - 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")) - | x -> failwith (sprintf "Unknown vmode '%s'" x) + Failure "float_of_string" -> () + end; + 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; + | "xyz" -> () (** Handled in Goto3D() *) + | "glide" -> + 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")) + | x -> failwith (sprintf "Unknown vmode '%s'" x) end; vmode @@ -225,16 +225,16 @@ 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 - | "direct" -> lprintf "NavGotoWaypoint(%s);\n" wp - | x -> failwith (sprintf "Unknown hmode '%s'" x) + "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 *) + ExtXml.Error _ -> lprintf "NavGotoWaypoint(%s);\n" wp; "direct" (* Default behaviour *) @@ -242,29 +242,29 @@ let output_hmode x wp last_wp = let rec index_stage = fun x -> begin match Xml.tag x with - "for" -> - incr stage; (* Init of i *) - incr stage; - let n = !stage in - let l = List.map index_stage (Xml.children x) in - incr stage; (* To count the loop stage *) - Xml.Element (Xml.tag x, Xml.attribs x@["no", soi n], l) - | "while" -> - incr stage; - let n = !stage in - let l = List.map index_stage (Xml.children x) in - incr stage; (* To count the loop stage *) - 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) - | "survey_rectangle" | "eight" | "oval"-> - incr stage; incr stage; - Xml.Element (Xml.tag x, Xml.attribs x@["no", soi !stage], Xml.children x) - | "exception" -> - x - | s -> failwith (sprintf "Unknown stage: %s\n" s) + "for" -> + incr stage; (* Init of i *) + incr stage; + let n = !stage in + let l = List.map index_stage (Xml.children x) in + incr stage; (* To count the loop stage *) + Xml.Element (Xml.tag x, Xml.attribs x@["no", soi n], l) + | "while" -> + incr stage; + let n = !stage in + let l = List.map index_stage (Xml.children x) in + incr stage; (* To count the loop stage *) + 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) + | "survey_rectangle" | "eight" | "oval"-> + incr stage; incr stage; + Xml.Element (Xml.tag x, Xml.attribs x@["no", soi !stage], Xml.children x) + | "exception" -> + x + | s -> failwith (sprintf "Unknown stage: %s\n" s) end @@ -274,229 +274,229 @@ let rec print_stage = fun index_of_waypoints x -> let stage () = incr stage;lprintf "Stage(%d)\n" !stage; right () in begin match String.lowercase (Xml.tag x) with - "return" -> - stage (); - lprintf "Return()\n"; - lprintf "break\n"; - | "goto" -> - stage (); - lprintf "Goto(%s)\n" (name_of x) - | "deroute" -> - 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" - | "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 - | "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; + "return" -> + stage (); + lprintf "Return()\n"; + lprintf "break\n"; + | "goto" -> + stage (); + lprintf "Goto(%s)\n" (name_of x) + | "deroute" -> + 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" + | "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 + | "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 (); + 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" - | "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" - | "attitude" -> - stage (); - begin - try + 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; - 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"; - begin - try - let c = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak();\n" c - with - ExtXml.Error _ -> () - end; - lprintf "break;\n" - | "stay" -> - stage (); - begin - try + 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" + | "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" + | "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"; + begin + try + let c = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak();\n" c + with + ExtXml.Error _ -> () + end; + 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" + | "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" + | "home" -> + stage (); + lprintf "nav_home();\n"; + lprintf "break;\n" + | "circle" -> + stage (); 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" - | "home" -> - 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" - | "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; - begin - try - let c = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak();\n" c - with - ExtXml.Error _ -> () - end; - 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" - | "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" - | "call" -> - 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" - | _s -> failwith "Unreachable" + 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; + begin + try + let c = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak();\n" c + with + ExtXml.Error _ -> () + end; + 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" + | "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" + | "call" -> + 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" + | _s -> failwith "Unreachable" end; left () @@ -508,16 +508,16 @@ 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; @@ -531,14 +531,14 @@ 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) @@ -590,12 +590,12 @@ let define_waypoints_indices = fun wpts -> let home = fun waypoints -> let rec loop i = function - [] -> failwith "Waypoint 'HOME' required" + [] -> 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 @@ -628,10 +628,10 @@ let check_geo_ref = fun wgs84 xml -> let dummy_waypoint = Xml.Element ("waypoint", - ["name", "dummy"; - "x", "42."; - "y", "42." ], - []) + ["name", "dummy"; + "x", "42."; + "y", "42." ], + []) @@ -641,12 +641,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 @@ -679,7 +679,7 @@ let parse_wpt_sector = fun waypoints xml -> and y = float_attrib wp "y" in {G2D.x2D = x; G2D.y2D = y } with - Not_found -> failwith (sprintf "Error: corner '%s' of sector '%s' not found" name sector_name) + 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)) @@ -689,7 +689,7 @@ 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 @@ -739,10 +739,10 @@ let () = printf "#include \"generated/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 @@ -756,8 +756,8 @@ let () = security_height := get_float "security_height"; ground_alt := get_float "ground_alt"; let home_mode_height = try - max (get_float "home_mode_height") !security_height - with _ -> !security_height in + max (get_float "home_mode_height") !security_height + with _ -> !security_height in check_altitude (float_of_string alt) xml; @@ -795,8 +795,8 @@ let () = 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 @@ -822,11 +822,11 @@ let () = let airspace = Xml.attrib xml "airspace" in lprintf "#define InAirspace(_x, _y) %s(_x, _y)\n" (inside_function airspace) with - _ -> () + _ -> () end; Xml2h.finish h_name end with - Failure x -> - fprintf stderr "%s: %s\n" !xml_file x; exit 1 + Failure x -> + fprintf stderr "%s: %s\n" !xml_file x; exit 1 diff --git a/sw/tools/gen_messages.ml b/sw/tools/gen_messages.ml index 3318a4a7d7..b6ab00f2d5 100644 --- a/sw/tools/gen_messages.ml +++ b/sw/tools/gen_messages.ml @@ -35,11 +35,11 @@ type field = _type * string * format option type fields = field list type message = { - name : string; - id : int; - period : float option; - fields : fields - } + name : string; + id : int; + period : float option; + fields : fields +} module Syntax = struct (** Parse a type name and returns a _type value *) @@ -56,15 +56,15 @@ module Syntax = struct try List.assoc t Pprz.types with - Not_found -> - failwith (sprintf "Error: '%s' unknown type" t) + Not_found -> + failwith (sprintf "Error: '%s' unknown type" t) let rec sizeof = function - Basic t -> string_of_int (assoc_types t).Pprz.size + Basic t -> string_of_int (assoc_types t).Pprz.size | Array (t, varname) -> sprintf "1+%s*%s" (length_name varname) (sizeof (Basic t)) let rec nameof = function - Basic t -> String.capitalize t + Basic t -> String.capitalize t | Array _ -> failwith "nameof" (** Translates a "message" XML element into a value of the 'message' type *) @@ -74,13 +74,13 @@ module Syntax = struct and period = try Some (ExtXml.float_attrib xml "period") with _ -> None and fields = List.map - (fun field -> - let id = ExtXml.attrib field "name" - and type_name = ExtXml.attrib field "type" - and fmt = try Some (Xml.attrib field "format") with _ -> None in - let _type = parse_type type_name id in - (_type, id, fmt)) - (Xml.children xml) in + (fun field -> + let id = ExtXml.attrib field "name" + and type_name = ExtXml.attrib field "type" + and fmt = try Some (Xml.attrib field "format") with _ -> None in + let _type = parse_type type_name id in + (_type, id, fmt)) + (Xml.children xml) in { id=id; name = name; period = period; fields = fields } let check_single_ids = fun msgs -> @@ -104,7 +104,7 @@ module Syntax = struct check_single_ids msgs; msgs with - Not_found -> failwith (sprintf "No class '%s' found" class_) + Not_found -> failwith (sprintf "No class '%s' found" class_) end (* module Suntax *) @@ -112,43 +112,43 @@ end (* module Suntax *) module Gen_onboard = struct let print_field = fun h (t, name, (_f: format option)) -> match t with - Basic _ -> - fprintf h "\t DownlinkPut%sByAddr(_trans, _dev, (%s)); \\\n" (Syntax.nameof t) name - | Array (t, varname) -> - let _s = Syntax.sizeof (Basic t) in - fprintf h "\t DownlinkPut%sArray(_trans, _dev, %s, %s); \\\n" (Syntax.nameof (Basic t)) (Syntax.length_name varname) name + Basic _ -> + fprintf h "\t DownlinkPut%sByAddr(_trans, _dev, (%s)); \\\n" (Syntax.nameof t) name + | Array (t, varname) -> + let _s = Syntax.sizeof (Basic t) in + fprintf h "\t DownlinkPut%sArray(_trans, _dev, %s, %s); \\\n" (Syntax.nameof (Basic t)) (Syntax.length_name varname) name let print_parameter h = function - (Array _, s, _) -> fprintf h "%s, %s" (Syntax.length_name s) s + (Array _, s, _) -> fprintf h "%s, %s" (Syntax.length_name s) s | (_, s, _) -> fprintf h "%s" s let print_macro_parameters h = function - [] -> () + [] -> () | f::fields -> - print_parameter h f; - List.iter (fun f -> fprintf h ", "; print_parameter h f) fields + print_parameter h f; + List.iter (fun f -> fprintf h ", "; print_parameter h f) fields let rec size_fields = fun fields size -> match fields with - [] -> size - | (t, _, _)::fields -> size_fields fields (size ^"+"^Syntax.sizeof t) + [] -> size + | (t, _, _)::fields -> size_fields fields (size ^"+"^Syntax.sizeof t) let size_of_message = fun m -> size_fields m.fields "0" let estimated_size_of_message = fun m -> try List.fold_right - (fun (t, _, _) r -> int_of_string (Syntax.sizeof t)+r) - m.fields - 0 + (fun (t, _, _) r -> int_of_string (Syntax.sizeof t)+r) + m.fields + 0 with - Failure "int_of_string" -> 0 + Failure "int_of_string" -> 0 let print_downlink_macro = fun h {name=s; fields = fields} -> if List.length fields > 0 then begin fprintf h "#define DOWNLINK_SEND_%s(_trans, _dev, " s; end else - fprintf h "#define DOWNLINK_SEND_%s(_trans, _dev " s; + fprintf h "#define DOWNLINK_SEND_%s(_trans, _dev " s; print_macro_parameters h fields; fprintf h "){ \\\n"; let size = (size_fields fields "0") in @@ -176,7 +176,7 @@ module Gen_onboard = struct fprintf stderr "Error: message %s has id %d but should be between 0 and 255\n" m.name m.id; exit 1; end else fprintf h "#define DL_%s %d\n" m.name m.id - ) messages; + ) messages; fprintf h "#define DL_MSG_%s_NB %d\n\n" class_ (List.length messages) (** Prints the table of the messages lengths *) @@ -195,8 +195,8 @@ module Gen_onboard = struct let sizes = List.map - (fun m -> (estimated_size_of_message m, m.name)) - messages in + (fun m -> (estimated_size_of_message m, m.name)) + messages in let sizes = List.sort (fun (s1,_) (s2,_) -> compare s2 s1) sizes in List.iter @@ -221,48 +221,48 @@ module Gen_onboard = struct (** Prints the macro for one field, using the global [offset] ref *) let parse_field = fun (_type, field_name, _format) -> if !offset < 0 then - failwith "FIXME: No field allowed after an array field (print_get_macros)"; + failwith "FIXME: No field allowed after an array field (print_get_macros)"; (** Converts bytes into the required type *) let typed = fun o pprz_type -> (* o for offset *) - let size = pprz_type.Pprz.size in - if check_alignment && o mod (min size 4) <> 0 then - failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); + let size = pprz_type.Pprz.size in + if check_alignment && o mod (min size 4) <> 0 then + failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); - match size with - 1 -> sprintf "(%s)(*((uint8_t*)_payload+%d))" pprz_type.Pprz.inttype o - | 2 -> sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8)" pprz_type.Pprz.inttype o o - | 4 when pprz_type.Pprz.inttype = "float" -> - sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24); _f.f; })" o o o o - | 8 when pprz_type.Pprz.inttype = "double" -> - let s = ref (sprintf "*((uint8_t*)_payload+%d)" o) in - for i = 1 to 7 do - s := !s ^ sprintf "|((uint64_t)*((uint8_t*)_payload+%d+%d))<<%d" o i (8*i) - done; + match size with + 1 -> sprintf "(%s)(*((uint8_t*)_payload+%d))" pprz_type.Pprz.inttype o + | 2 -> sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8)" pprz_type.Pprz.inttype o o + | 4 when pprz_type.Pprz.inttype = "float" -> + sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24); _f.f; })" o o o o + | 8 when pprz_type.Pprz.inttype = "double" -> + let s = ref (sprintf "*((uint8_t*)_payload+%d)" o) in + for i = 1 to 7 do + s := !s ^ sprintf "|((uint64_t)*((uint8_t*)_payload+%d+%d))<<%d" o i (8*i) + done; - sprintf "({ union { uint64_t u; double f; } _f; _f.u = (uint64_t)(%s); Swap32IfBigEndian(_f.u); _f.f; })" !s - | 4 -> - sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24)" pprz_type.Pprz.inttype o o o o - | _ -> failwith "unexpected size in Gen_messages.print_get_macros" in + sprintf "({ union { uint64_t u; double f; } _f; _f.u = (uint64_t)(%s); Swap32IfBigEndian(_f.u); _f.f; })" !s + | 4 -> + sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24)" pprz_type.Pprz.inttype o o o o + | _ -> failwith "unexpected size in Gen_messages.print_get_macros" in (** To be an array or not to be an array: *) match _type with - Basic t -> - let pprz_type = Syntax.assoc_types t in - fprintf h "#define DL_%s_%s(_payload) (%s)\n" msg_name field_name (typed !offset pprz_type); - offset := !offset + pprz_type.Pprz.size + Basic t -> + let pprz_type = Syntax.assoc_types t in + fprintf h "#define DL_%s_%s(_payload) (%s)\n" msg_name field_name (typed !offset pprz_type); + offset := !offset + pprz_type.Pprz.size - | Array (t, _varname) -> - (** The macro to access to the length of the array *) - fprintf h "#define DL_%s_%s_length(_payload) (%s)\n" msg_name field_name (typed !offset (Syntax.assoc_types "uint8")); - incr offset; + | Array (t, _varname) -> + (** The macro to access to the length of the array *) + fprintf h "#define DL_%s_%s_length(_payload) (%s)\n" msg_name field_name (typed !offset (Syntax.assoc_types "uint8")); + incr offset; - (** The macro to access to the array itself *) - let pprz_type = Syntax.assoc_types t in - if check_alignment && !offset mod (min pprz_type.Pprz.size 4) <> 0 then - failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); + (** The macro to access to the array itself *) + let pprz_type = Syntax.assoc_types t in + if check_alignment && !offset mod (min pprz_type.Pprz.size 4) <> 0 then + failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); - fprintf h "#define DL_%s_%s(_payload) ((%s*)(_payload+%d))\n" msg_name field_name pprz_type.Pprz.inttype !offset; - offset := -1 (** Mark for no more fields *) + fprintf h "#define DL_%s_%s(_payload) ((%s*)(_payload+%d))\n" msg_name field_name pprz_type.Pprz.inttype !offset; + offset := -1 (** Mark for no more fields *) in fprintf h "\n"; @@ -307,4 +307,4 @@ let () = List.iter (Gen_onboard.print_get_macros h check_alignment) messages with - Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) + Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) diff --git a/sw/tools/gen_messages2.ml b/sw/tools/gen_messages2.ml index 88dad3439d..2234059c76 100644 --- a/sw/tools/gen_messages2.ml +++ b/sw/tools/gen_messages2.ml @@ -32,38 +32,38 @@ type _type = let c_type = fun format -> match format with - "Float" -> "float" - | "Double" -> "double" - | "Int32" -> "int32_t" - | "Int16" -> "int16_t" - | "Int8" -> "int8_t" - | "Uint32" -> "uint32_t" - | "Uint16" -> "uint16_t" - | "Uint8" -> "uint8_t" - | _ -> failwith (sprintf "gen_messages.c_type: unknown format '%s'" format) + "Float" -> "float" + | "Double" -> "double" + | "Int32" -> "int32_t" + | "Int16" -> "int16_t" + | "Int8" -> "int8_t" + | "Uint32" -> "uint32_t" + | "Uint16" -> "uint16_t" + | "Uint8" -> "uint8_t" + | _ -> failwith (sprintf "gen_messages.c_type: unknown format '%s'" format) let dl_type = fun format -> match format with - "Float" -> "DL_TYPE_FLOAT" - | "Double" -> "DL_TYPE_DOUBLE" - | "Int32" -> "DL_TYPE_INT32" - | "Int16" -> "DL_TYPE_INT16" - | "Int8" -> "DL_TYPE_INT8" - | "Uint32" -> "DL_TYPE_UINT32" - | "Uint16" -> "DL_TYPE_UINT16" - | "Uint8" -> "DL_TYPE_UINT8" - | _ -> failwith (sprintf "gen_messages.c_type: unknown format '%s'" format) + "Float" -> "DL_TYPE_FLOAT" + | "Double" -> "DL_TYPE_DOUBLE" + | "Int32" -> "DL_TYPE_INT32" + | "Int16" -> "DL_TYPE_INT16" + | "Int8" -> "DL_TYPE_INT8" + | "Uint32" -> "DL_TYPE_UINT32" + | "Uint16" -> "DL_TYPE_UINT16" + | "Uint8" -> "DL_TYPE_UINT8" + | _ -> failwith (sprintf "gen_messages.c_type: unknown format '%s'" format) type field = _type * string * format option type fields = field list type message = { - name : string; - id : int; - period : float option; - fields : fields - } + name : string; + id : int; + period : float option; + fields : fields +} module Syntax = struct (** Parse a type name and returns a _type value *) @@ -80,15 +80,15 @@ module Syntax = struct try List.assoc t Pprz.types with - Not_found -> - failwith (sprintf "Error: '%s' unknown type" t) + Not_found -> + failwith (sprintf "Error: '%s' unknown type" t) let rec sizeof = function - Basic t -> string_of_int (assoc_types t).Pprz.size + Basic t -> string_of_int (assoc_types t).Pprz.size | Array (t, varname) -> sprintf "1+%s*%s" (length_name varname) (sizeof (Basic t)) let rec nameof = function - Basic t -> String.capitalize t + Basic t -> String.capitalize t | Array _ -> failwith "nameof" (** Translates a "message" XML element into a value of the 'message' type *) @@ -98,13 +98,13 @@ module Syntax = struct and period = try Some (ExtXml.float_attrib xml "period") with _ -> None and fields = List.map - (fun field -> - let id = ExtXml.attrib field "name" - and type_name = ExtXml.attrib field "type" - and fmt = try Some (Xml.attrib field "format") with _ -> None in - let _type = parse_type type_name id in - (_type, id, fmt)) - (Xml.children xml) in + (fun field -> + let id = ExtXml.attrib field "name" + and type_name = ExtXml.attrib field "type" + and fmt = try Some (Xml.attrib field "format") with _ -> None in + let _type = parse_type type_name id in + (_type, id, fmt)) + (Xml.children xml) in { id=id; name = name; period = period; fields = fields } let check_single_ids = fun msgs -> @@ -128,7 +128,7 @@ module Syntax = struct check_single_ids msgs; msgs with - Not_found -> failwith (sprintf "No class '%s' found" class_) + Not_found -> failwith (sprintf "No class '%s' found" class_) end (* module Suntax *) @@ -136,44 +136,44 @@ end (* module Suntax *) module Gen_onboard = struct let print_field = fun h (t, name, (_f: format option)) -> match t with - Basic _ -> - fprintf h "\t tp->PutBytes(tp->impl, %s, %s, (void *) _%s); \n" (dl_type (Syntax.nameof t)) (Syntax.sizeof t) name - | Array (t, varname) -> - let _s = Syntax.sizeof (Basic t) in - fprintf h "\t tp->PutBytes(tp->impl, DL_TYPE_ARRAY_LENGTH, 1, (void *) &%s); \n" (Syntax.length_name varname); - fprintf h "\t tp->PutBytes(tp->impl, %s, %s * %s, (void *) _%s); \n" (dl_type (Syntax.nameof (Basic t))) (Syntax.sizeof (Basic t)) (Syntax.length_name varname) name + Basic _ -> + fprintf h "\t tp->PutBytes(tp->impl, %s, %s, (void *) _%s); \n" (dl_type (Syntax.nameof t)) (Syntax.sizeof t) name + | Array (t, varname) -> + let _s = Syntax.sizeof (Basic t) in + fprintf h "\t tp->PutBytes(tp->impl, DL_TYPE_ARRAY_LENGTH, 1, (void *) &%s); \n" (Syntax.length_name varname); + fprintf h "\t tp->PutBytes(tp->impl, %s, %s * %s, (void *) _%s); \n" (dl_type (Syntax.nameof (Basic t))) (Syntax.sizeof (Basic t)) (Syntax.length_name varname) name let print_parameter h = function - (Array (t, varname), s, _) -> fprintf h "uint8_t %s, %s *_%s" (Syntax.length_name s) (c_type (Syntax.nameof (Basic t))) s + (Array (t, varname), s, _) -> fprintf h "uint8_t %s, %s *_%s" (Syntax.length_name s) (c_type (Syntax.nameof (Basic t))) s | (t, s, _) -> fprintf h "%s *_%s" (c_type (Syntax.nameof t)) s let print_macro_parameters h = function - [] -> () + [] -> () | f::fields -> - print_parameter h f; - List.iter (fun f -> fprintf h ", "; print_parameter h f) fields + print_parameter h f; + List.iter (fun f -> fprintf h ", "; print_parameter h f) fields let rec size_fields = fun fields size -> match fields with - [] -> size - | (t, _, _)::fields -> size_fields fields (size ^"+"^Syntax.sizeof t) + [] -> size + | (t, _, _)::fields -> size_fields fields (size ^"+"^Syntax.sizeof t) let size_of_message = fun m -> size_fields m.fields "0" let estimated_size_of_message = fun m -> try List.fold_right - (fun (t, _, _) r -> int_of_string (Syntax.sizeof t)+r) - m.fields - 0 + (fun (t, _, _) r -> int_of_string (Syntax.sizeof t)+r) + m.fields + 0 with - Failure "int_of_string" -> 0 + Failure "int_of_string" -> 0 let print_downlink_macro = fun h {name=s; fields = fields} -> if List.length fields > 0 then begin fprintf h "static inline void DOWNLINK_SEND_%s(struct DownlinkTransport *tp, " s; end else - fprintf h "static inline void DOWNLINK_SEND_%s(struct DownlinkTransport *tp " s; + fprintf h "static inline void DOWNLINK_SEND_%s(struct DownlinkTransport *tp " s; print_macro_parameters h fields; fprintf h "){ \n"; let size = (size_fields fields "0") in @@ -201,7 +201,7 @@ module Gen_onboard = struct fprintf stderr "Error: message %s has id %d but should be between 0 and 255\n" m.name m.id; exit 1; end else fprintf h "#define DL_%s %d\n" m.name m.id - ) messages; + ) messages; fprintf h "#define DL_MSG_%s_NB %d\n\n" class_ (List.length messages) (** Prints the table of the messages lengths *) @@ -220,8 +220,8 @@ module Gen_onboard = struct let sizes = List.map - (fun m -> (estimated_size_of_message m, m.name)) - messages in + (fun m -> (estimated_size_of_message m, m.name)) + messages in let sizes = List.sort (fun (s1,_) (s2,_) -> compare s2 s1) sizes in List.iter @@ -246,48 +246,48 @@ module Gen_onboard = struct (** Prints the macro for one field, using the global [offset] ref *) let parse_field = fun (_type, field_name, _format) -> if !offset < 0 then - failwith "FIXME: No field allowed after an array field (print_get_macros)"; + failwith "FIXME: No field allowed after an array field (print_get_macros)"; (** Converts bytes into the required type *) let typed = fun o pprz_type -> (* o for offset *) - let size = pprz_type.Pprz.size in - if check_alignment && o mod (min size 4) <> 0 then - failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); + let size = pprz_type.Pprz.size in + if check_alignment && o mod (min size 4) <> 0 then + failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); - match size with - 1 -> sprintf "(%s)(*((uint8_t*)_payload+%d))" pprz_type.Pprz.inttype o - | 2 -> sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8)" pprz_type.Pprz.inttype o o - | 4 when pprz_type.Pprz.inttype = "float" -> - sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24); _f.f; })" o o o o - | 8 when pprz_type.Pprz.inttype = "double" -> - let s = ref (sprintf "*((uint8_t*)_payload+%d)" o) in - for i = 1 to 7 do - s := !s ^ sprintf "|((uint64_t)*((uint8_t*)_payload+%d+%d))<<%d" o i (8*i) - done; + match size with + 1 -> sprintf "(%s)(*((uint8_t*)_payload+%d))" pprz_type.Pprz.inttype o + | 2 -> sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8)" pprz_type.Pprz.inttype o o + | 4 when pprz_type.Pprz.inttype = "float" -> + sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24); _f.f; })" o o o o + | 8 when pprz_type.Pprz.inttype = "double" -> + let s = ref (sprintf "*((uint8_t*)_payload+%d)" o) in + for i = 1 to 7 do + s := !s ^ sprintf "|((uint64_t)*((uint8_t*)_payload+%d+%d))<<%d" o i (8*i) + done; - sprintf "({ union { uint64_t u; double f; } _f; _f.u = (uint64_t)(%s); Swap32IfBigEndian(_f.u); _f.f; })" !s - | 4 -> - sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24)" pprz_type.Pprz.inttype o o o o - | _ -> failwith "unexpected size in Gen_messages.print_get_macros" in + sprintf "({ union { uint64_t u; double f; } _f; _f.u = (uint64_t)(%s); Swap32IfBigEndian(_f.u); _f.f; })" !s + | 4 -> + sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24)" pprz_type.Pprz.inttype o o o o + | _ -> failwith "unexpected size in Gen_messages.print_get_macros" in (** To be an array or not to be an array: *) match _type with - Basic t -> - let pprz_type = Syntax.assoc_types t in - fprintf h "#define DL_%s_%s(_payload) (%s)\n" msg_name field_name (typed !offset pprz_type); - offset := !offset + pprz_type.Pprz.size + Basic t -> + let pprz_type = Syntax.assoc_types t in + fprintf h "#define DL_%s_%s(_payload) (%s)\n" msg_name field_name (typed !offset pprz_type); + offset := !offset + pprz_type.Pprz.size - | Array (t, _varname) -> - (** The macro to access to the length of the array *) - fprintf h "#define DL_%s_%s_length(_payload) (%s)\n" msg_name field_name (typed !offset (Syntax.assoc_types "uint8")); - incr offset; + | Array (t, _varname) -> + (** The macro to access to the length of the array *) + fprintf h "#define DL_%s_%s_length(_payload) (%s)\n" msg_name field_name (typed !offset (Syntax.assoc_types "uint8")); + incr offset; - (** The macro to access to the array itself *) - let pprz_type = Syntax.assoc_types t in - if check_alignment && !offset mod (min pprz_type.Pprz.size 4) <> 0 then - failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); + (** The macro to access to the array itself *) + let pprz_type = Syntax.assoc_types t in + if check_alignment && !offset mod (min pprz_type.Pprz.size 4) <> 0 then + failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); - fprintf h "#define DL_%s_%s(_payload) ((%s*)(_payload+%d))\n" msg_name field_name pprz_type.Pprz.inttype !offset; - offset := -1 (** Mark for no more fields *) + fprintf h "#define DL_%s_%s(_payload) ((%s*)(_payload+%d))\n" msg_name field_name pprz_type.Pprz.inttype !offset; + offset := -1 (** Mark for no more fields *) in fprintf h "\n"; @@ -337,4 +337,4 @@ let () = Printf.fprintf h "#endif // _VAR_MESSAGES2_%s_H_\n" class_name with - Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) + Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) diff --git a/sw/tools/gen_modules.ml b/sw/tools/gen_modules.ml index 48fc984e25..1b4db5371f 100644 --- a/sw/tools/gen_modules.ml +++ b/sw/tools/gen_modules.ml @@ -51,9 +51,9 @@ let print_headers = fun modules -> List.iter (fun h -> let dir = ExtXml.attrib_or_default h "dir" dir_name in lprintf out_h "#include \"%s/%s\"\n" dir (Xml.attrib h "name")) - (Xml.children headers) + (Xml.children headers) with _ -> ()) - modules + modules let get_status_name = fun f n -> let func = (Xml.attrib f "fun") in @@ -67,10 +67,10 @@ let get_period_and_freq = fun f max_freq -> let period = try Some (float_of_string (Xml.attrib f "period")) with _ -> None and freq = try Some (float_of_string (Xml.attrib f "freq")) with _ -> None in match period, freq with - | None, None -> (1. /. max_freq, max_freq) - | Some _p, None -> (_p, 1. /. _p) - | None, Some _f -> (1. /. _f, _f) - | Some _p, Some _ -> + | None, None -> (1. /. max_freq, max_freq) + | Some _p, None -> (_p, 1. /. _p) + | None, Some _f -> (1. /. _f, _f) + | Some _p, Some _ -> fprintf stderr "Warning: both period and freq are defined but only period is used for function %s\n" (ExtXml.attrib f "fun"); (_p, 1. /. _p) @@ -78,10 +78,10 @@ let get_period_and_freq = fun f max_freq -> let get_cap_name = fun f -> let name = Str.full_split (Str.regexp "[()]") f in match name with - | [Str.Text t] - | [Str.Text t; Str.Delim "("; Str.Delim ")"] - | [Str.Text t; Str.Delim "("; Str.Text _ ; Str.Delim ")"] -> String.uppercase t - | _ -> failwith "Gen_modules: not a valid function name" + | [Str.Text t] + | [Str.Text t; Str.Delim "("; Str.Delim ")"] + | [Str.Text t; Str.Delim "("; Str.Text _ ; Str.Delim ")"] -> String.uppercase t + | _ -> failwith "Gen_modules: not a valid function name" let print_function_freq = fun modules -> let max_freq = float !freq in @@ -89,14 +89,14 @@ let print_function_freq = fun modules -> List.iter (fun m -> List.iter (fun i -> match Xml.tag i with - "periodic" -> - let fname = get_cap_name (Xml.attrib i "fun") in - let p, f = get_period_and_freq i max_freq in - lprintf out_h "#define %s_PERIOD %f\n" fname p; - lprintf out_h "#define %s_FREQ %f\n" fname f; - | _ -> ()) - (Xml.children m)) - modules + "periodic" -> + let fname = get_cap_name (Xml.attrib i "fun") in + let p, f = get_period_and_freq i max_freq in + lprintf out_h "#define %s_PERIOD %f\n" fname p; + lprintf out_h "#define %s_FREQ %f\n" fname f; + | _ -> ()) + (Xml.children m)) + modules let is_status_lock = fun p -> let mode = ExtXml.attrib_or_default p "autorun" "LOCK" in @@ -108,13 +108,13 @@ let print_status = fun modules -> let module_name = ExtXml.attrib m "name" in List.iter (fun i -> match Xml.tag i with - "periodic" -> - if not (is_status_lock i) then begin - lprintf out_h "EXTERN_MODULES uint8_t %s;\n" (get_status_name i module_name); - end - | _ -> ()) - (Xml.children m)) - modules + "periodic" -> + if not (is_status_lock i) then begin + lprintf out_h "EXTERN_MODULES uint8_t %s;\n" (get_status_name i module_name); + end + | _ -> ()) + (Xml.children m)) + modules let print_init_functions = fun modules -> lprintf out_h "\nstatic inline void modules_init(void) {\n"; @@ -123,16 +123,16 @@ let print_init_functions = fun modules -> let module_name = ExtXml.attrib m "name" in List.iter (fun i -> match Xml.tag i with - "init" -> lprintf out_h "%s;\n" (Xml.attrib i "fun") - | "periodic" -> if not (is_status_lock i) then - lprintf out_h "%s = %s;\n" (get_status_name i module_name) (try match Xml.attrib i "autorun" with - "TRUE" | "true" -> "MODULES_START" - | "FALSE" | "false" | "LOCK" | "lock" -> "MODULES_IDLE" - | _ -> failwith "Error: Unknown autorun value (possible values are: TRUE, FALSE, LOCK(default))" - with _ -> "MODULES_IDLE" (* this should not be possible anyway *)) - | _ -> ()) - (Xml.children m)) - modules; + "init" -> lprintf out_h "%s;\n" (Xml.attrib i "fun") + | "periodic" -> if not (is_status_lock i) then + lprintf out_h "%s = %s;\n" (get_status_name i module_name) (try match Xml.attrib i "autorun" with + "TRUE" | "true" -> "MODULES_START" + | "FALSE" | "false" | "LOCK" | "lock" -> "MODULES_IDLE" + | _ -> failwith "Error: Unknown autorun value (possible values are: TRUE, FALSE, LOCK(default))" + with _ -> "MODULES_IDLE" (* this should not be possible anyway *)) + | _ -> ()) + (Xml.children m)) + modules; left (); lprintf out_h "}\n" @@ -152,17 +152,17 @@ let print_periodic_functions = fun modules -> let p, _ = get_period_and_freq x max_freq in if p < min_period || p > max_period then fprintf stderr "Warning: period is bound between %.3fs and %.3fs (%fHz and %.1fHz) for function %s\n%!" - min_period max_period max_freq min_freq (ExtXml.attrib x "fun"); + min_period max_period max_freq min_freq (ExtXml.attrib x "fun"); ((x, module_name), min 65535 (max 1 (int_of_float (p *. float_of_int !freq)))) - ) periodic) - modules) in + ) periodic) + modules) in let modulos = GC.singletonize (List.map snd functions_modulo) in (** Print modulos *) List.iter (fun modulo -> let v = sprintf "i%d" modulo in let _type = if modulo >= 256 then "uint16_t" else "uint8_t" in lprintf out_h "static %s %s; %s++; if (%s>=%d) %s=0;\n" _type v v v modulo v;) - modulos; + modulos; (** Print start and stop functions *) List.iter (fun m -> let module_name = ExtXml.attrib m "name" in @@ -171,7 +171,7 @@ let print_periodic_functions = fun modules -> List.iter (fun f -> if (is_status_lock f) then begin try lprintf out_h "%s;\n" (Xml.attrib f "start") with _ -> (); - try let stop = Xml.attrib f "stop" in fprintf stderr "Warning: stop %s function will not be called\n" stop with _ -> (); + try let stop = Xml.attrib f "stop" in fprintf stderr "Warning: stop %s function will not be called\n" stop with _ -> (); end else begin let status = get_status_name f module_name in @@ -180,9 +180,9 @@ let print_periodic_functions = fun modules -> let stop = (ExtXml.attrib_or_default f "stop" "") in lprintf out_h "if (%s == MODULES_STOP) { %s; %s = MODULES_IDLE; }\n" status stop status; end - ) - periodic) - modules; + ) + periodic) + modules; (** Print periodic functions *) let functions = List.sort (fun (_,p) (_,p') -> compare p p') functions_modulo in let i = ref 0 in (** Basic balancing:1 function every 10Hz FIXME *) @@ -211,7 +211,7 @@ let print_periodic_functions = fun modules -> if delay >= p then fprintf stderr "Warning: delay is bound between 0 and %d for function %s\n" (p-1) function_name; let delay_p = delay mod p in let else_ = if List.mem_assoc p !l && not (List.mem (p, delay_p) !l) then - "else " else "" in + "else " else "" in if (is_status_lock func) then lprintf out_h "%sif (i%d == %d) {\n" else_ p delay_p else @@ -245,10 +245,10 @@ let print_event_functions = fun modules -> List.iter (fun m -> List.iter (fun i -> match Xml.tag i with - "event" -> lprintf out_h "%s;\n" (Xml.attrib i "fun") - | _ -> ()) - (Xml.children m)) - modules; + "event" -> lprintf out_h "%s;\n" (Xml.attrib i "fun") + | _ -> ()) + (Xml.children m)) + modules; left (); lprintf out_h "}\n" @@ -261,12 +261,12 @@ let print_datalink_functions = fun modules -> List.iter (fun m -> List.iter (fun i -> match Xml.tag i with - "datalink" -> - lprintf out_h "%sif (msg_id == DL_%s) { %s; }\n" !else_ (ExtXml.attrib i "message") (ExtXml.attrib i "fun"); - else_ := "else " - | _ -> ()) - (Xml.children m)) - modules; + "datalink" -> + lprintf out_h "%sif (msg_id == DL_%s) { %s; }\n" !else_ (ExtXml.attrib i "message") (ExtXml.attrib i "fun"); + else_ := "else " + | _ -> ()) + (Xml.children m)) + modules; left (); lprintf out_h "}\n" @@ -296,7 +296,7 @@ let dep_of_field = fun field att -> try Str.split pipe_regexp (Xml.attrib field att) with - _ -> [] + _ -> [] let check_dependencies = fun modules names -> List.iter (fun m -> @@ -306,12 +306,12 @@ let check_dependencies = fun modules names -> List.iter (fun req -> if not (List.exists (fun c -> String.compare c req == 0) names) then fprintf stderr "\nWARNING: Dependency not satisfied: module %s requires %s\n" (Xml.attrib m "name") req) - require; + require; let conflict = dep_of_field dep "conflict" in List.iter (fun con -> if List.exists (fun c -> String.compare c con == 0) names then fprintf stderr "\nWARNING: Dependency not satisfied: module %s conflicts with %s\n" (Xml.attrib m "name") con) - conflict + conflict with _ -> () ) modules @@ -325,18 +325,18 @@ let write_settings = fun xml_file out_set modules -> let module_name = ExtXml.attrib m "name" in List.iter (fun i -> match Xml.tag i with - "periodic" -> - if not (is_status_lock i) then begin - if (not !setting_exist) then begin - fprintf out_set " \n"; - setting_exist := true; - end; - fprintf out_set " \n" - (get_status_name i module_name) (get_status_shortname i) - end - | _ -> ()) - (Xml.children m)) - modules; + "periodic" -> + if not (is_status_lock i) then begin + if (not !setting_exist) then begin + fprintf out_set " \n"; + setting_exist := true; + end; + fprintf out_set " \n" + (get_status_name i module_name) (get_status_shortname i) + end + | _ -> ()) + (Xml.children m)) + modules; if !setting_exist then fprintf out_set " \n"; fprintf out_set " \n"; fprintf out_set "\n" @@ -371,7 +371,7 @@ let () = (* Extract modules names (file name and module name) *) let modules_name = (List.map (fun m -> try Xml.attrib m.GC.xml "name" with _ -> "") modules) @ - (List.map (fun m -> m.GC.file) modules) in + (List.map (fun m -> m.GC.file) modules) in (* Extract xml modules nodes *) let modules_list = List.map (fun m -> m.GC.xml) modules in check_dependencies modules_list modules_name; @@ -380,7 +380,7 @@ let () = write_settings xml_file out_set modules_list; close_out out_set; with - Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 - | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 - | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 - | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 + Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 + | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 + | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 + | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 diff --git a/sw/tools/gen_mtk.ml b/sw/tools/gen_mtk.ml index 57bf8ce516..2fb96de0ad 100644 --- a/sw/tools/gen_mtk.ml +++ b/sw/tools/gen_mtk.ml @@ -27,7 +27,7 @@ open Printf let out = stdout let sizeof = function - "U4" | "I4" -> 4 +"U4" | "I4" -> 4 | "U2" | "I2" -> 2 | "U1" | "I1" -> 1 | "U4BE" | "I4BE" -> 4 @@ -38,29 +38,29 @@ let (+=) = fun r x -> r := !r + x let c_type = fun format -> match format with - "I2" -> "int16_t" - | "I4" -> "int32_t" - | "U2" -> "uint16_t" - | "U4" -> "uint32_t" - | "U1" -> "uint8_t" - | "I1" -> "int8_t" - | "I2BE" -> "int16_t" - | "I4BE" -> "int32_t" - | "U2BE" -> "uint16_t" - | "U4BE" -> "uint32_t" - | _ -> failwith (sprintf "Gen_mtk.c_type: unknown format '%s'" format) + "I2" -> "int16_t" + | "I4" -> "int32_t" + | "U2" -> "uint16_t" + | "U4" -> "uint32_t" + | "U1" -> "uint8_t" + | "I1" -> "int8_t" + | "I2BE" -> "int16_t" + | "I4BE" -> "int32_t" + | "U2BE" -> "uint16_t" + | "U4BE" -> "uint32_t" + | _ -> failwith (sprintf "Gen_mtk.c_type: unknown format '%s'" format) let get_at = fun offset format block_size -> let t = c_type format in let block_offset = if block_size = 0 then "" else sprintf "+%d*_mtk_block" block_size in match format with - "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s)|*((uint8_t*)_mtk_payload+1+%d%s)<<8|((%s)*((uint8_t*)_mtk_payload+2+%d%s))<<16|((%s)*((uint8_t*)_mtk_payload+3+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset - | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s)|*((uint8_t*)_mtk_payload+1+%d%s)<<8)" t offset block_offset offset block_offset - | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s))" t offset block_offset - | "U4BE" | "I4BE" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+3+%d%s)|*((uint8_t*)_mtk_payload+2+%d%s)<<8|((%s)*((uint8_t*)_mtk_payload+1+%d%s))<<16|((%s)*((uint8_t*)_mtk_payload+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset - | "U2BE" | "I2BE" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+1+%d%s)|*((uint8_t*)_mtk_payload+%d%s)<<8)" t offset block_offset offset block_offset - | _ -> failwith (sprintf "Gen_mtk.c_type: unknown format '%s'" format) + "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s)|*((uint8_t*)_mtk_payload+1+%d%s)<<8|((%s)*((uint8_t*)_mtk_payload+2+%d%s))<<16|((%s)*((uint8_t*)_mtk_payload+3+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset + | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s)|*((uint8_t*)_mtk_payload+1+%d%s)<<8)" t offset block_offset offset block_offset + | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s))" t offset block_offset + | "U4BE" | "I4BE" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+3+%d%s)|*((uint8_t*)_mtk_payload+2+%d%s)<<8|((%s)*((uint8_t*)_mtk_payload+1+%d%s))<<16|((%s)*((uint8_t*)_mtk_payload+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset + | "U2BE" | "I2BE" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+1+%d%s)|*((uint8_t*)_mtk_payload+%d%s)<<8)" t offset block_offset offset block_offset + | _ -> failwith (sprintf "Gen_mtk.c_type: unknown format '%s'" format) let define = fun x y -> fprintf out "#define %s %s\n" x y @@ -83,19 +83,19 @@ let parse_message = fun class_name m -> let offset = ref 0 in let rec gen_access_macro = fun block_size f -> match Xml.tag f with - "field" -> - let fn = field_name f - and fmt = format f in - let block_no = if block_size = 0 then "" else ",_mtk_block" in - define (sprintf "MTK_%s_%s_%s(_mtk_payload%s)" class_name msg_name fn block_no) (get_at !offset fmt block_size); - offset += sizeof fmt - | "block" -> - let s = int_of_string (Xml.attrib f "length") in - let o = !offset in - List.iter (gen_access_macro s) (Xml.children f); - let s' = !offset - o in - if s <> s' then raise (Length_error (f, s, s')) - | x -> failwith ("Unexpected field: " ^ x) + "field" -> + let fn = field_name f + and fmt = format f in + let block_no = if block_size = 0 then "" else ",_mtk_block" in + define (sprintf "MTK_%s_%s_%s(_mtk_payload%s)" class_name msg_name fn block_no) (get_at !offset fmt block_size); + offset += sizeof fmt + | "block" -> + let s = int_of_string (Xml.attrib f "length") in + let o = !offset in + List.iter (gen_access_macro s) (Xml.children f); + let s' = !offset - o in + if s <> s' then raise (Length_error (f, s, s')) + | x -> failwith ("Unexpected field: " ^ x) in List.iter (gen_access_macro 0) (Xml.children m); @@ -104,7 +104,7 @@ let parse_message = fun class_name m -> let l = int_of_string (Xml.attrib m "length") in if l <> !offset then raise (Length_error (m, l, !offset)) with - Xml.No_attribute("length") -> () (** Undefined length authorized *) + Xml.No_attribute("length") -> () (** Undefined length authorized *) end; (** Generating send function *) @@ -121,14 +121,14 @@ let parse_message = fun class_name m -> fprintf out " MtkHeader(MTK_%s_ID, %s, %d);\\\n" class_name msg_id !offset; let rec send_one_field = fun f -> match Xml.tag f with - "field" -> - let s = sizeof (format f) in - let p = param_name f in - let t = param_type f in - fprintf out " %s _%s = %s; MtkSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p - | "block" -> - List.iter send_one_field (Xml.children f) - | _ -> assert (false) in + "field" -> + let s = sizeof (format f) in + let p = param_name f in + let t = param_type f in + fprintf out " %s _%s = %s; MtkSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p + | "block" -> + List.iter send_one_field (Xml.children f) + | _ -> assert (false) in List.iter send_one_field (Xml.children m); fprintf out " MtkTrailer();\\\n"; fprintf out "}\n\n#define MTK_%s_%s_LENGTH %d\n" class_name msg_name !offset @@ -159,16 +159,16 @@ let _ = List.iter parse_class (Xml.children xml) with - Xml.Error (em, ep) -> - let l = Xml.line ep - and c1, c2 = Xml.range ep in - fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; - fprintf stderr "%s\n" (Xml.error_msg em); - exit 1 - | Length_error (m, l1, l2) -> + Xml.Error (em, ep) -> + let l = Xml.line ep + and c1, c2 = Xml.range ep in + fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; + fprintf stderr "%s\n" (Xml.error_msg em); + exit 1 + | Length_error (m, l1, l2) -> fprintf stderr "File \"%s\", inconsistent length: %d expected, %d found from fields in message:\n %s\n" xml_file l1 l2 (Xml.to_string_fmt m); exit 1 - | Dtd.Check_error e -> + | Dtd.Check_error e -> fprintf stderr "File \"%s\", DTD check error: %s\n" xml_file (Dtd.check_error e) - | Dtd.Prove_error e -> + | Dtd.Prove_error e -> fprintf stderr "\nFile \"%s\", DTD check error: %s\n\n" xml_file (Dtd.prove_error e) diff --git a/sw/tools/gen_periodic.ml b/sw/tools/gen_periodic.ml index 546e34427e..253182f8c3 100644 --- a/sw/tools/gen_periodic.ml +++ b/sw/tools/gen_periodic.ml @@ -50,20 +50,20 @@ let output_modes = fun out_h process_name modes freq modules -> (** Filter message list to remove messages linked to unloaded modules *) let filtered_msg = List.filter (fun msg -> try let att = Xml.attrib msg "module" in List.exists (fun name -> String.compare name att = 0) modules with _ -> true - ) (Xml.children mode) in + ) (Xml.children mode) in (** Computes the required modulos *) let messages = List.map (fun x -> let p = float_of_string (ExtXml.attrib x "period") in if p < min_period || p > max_period then 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 + ) filtered_msg 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 lprintf out_h "static %s %s = 0; %s++; if (%s>=%d) %s=0;\\\n" _type v v v m v; - ) modulos; + ) modulos; (** For each message in this mode *) let messages = List.sort (fun (_,p) (_,p') -> compare p p') messages in @@ -104,14 +104,14 @@ let write_settings = fun xml_file out_set telemetry_xml -> let modes = List.map (fun m -> Xml.attrib m "name") (Xml.children p) in let nb_modes = List.length modes in match nb_modes with - 0 | 1 -> () (* Nothing to do if 1 or zero mode *) - | _ -> (* add settings with all modes *) + 0 | 1 -> () (* Nothing to do if 1 or zero mode *) + | _ -> (* add settings with all modes *) fprintf out_set " \n" (nb_modes-1) process_name process_name (String.concat "|" modes); let i = ref 0 in List.iter (fun m -> try - let key = Xml.attrib m "key_press" in - fprintf out_set " \n" key (string_of_int !i); - incr i + let key = Xml.attrib m "key_press" in + fprintf out_set " \n" key (string_of_int !i); + incr i with _ -> incr i) (Xml.children p); fprintf out_set " \n" ) (Xml.children telemetry_xml); diff --git a/sw/tools/gen_radio.ml b/sw/tools/gen_radio.ml index c66f72614f..5d48af1a8b 100644 --- a/sw/tools/gen_radio.ml +++ b/sw/tools/gen_radio.ml @@ -31,20 +31,20 @@ let fos = float_of_string type us = int type channel = { - name : string; - min : us; - max : us; - neutral : us; - averaged : bool } + name : string; + min : us; + max : us; + neutral : us; + averaged : bool } (* Characters used in Gen_airframe.pprz_value *) let check_function_name = fun s -> for i = 0 to String.length s - 1 do match s.[i] with - 'A'..'Z' | '0'..'9' | '_' -> () - | _ -> - failwith (sprintf "Character '%c' not allowed in function name '%s'" s.[i] s) + 'A'..'Z' | '0'..'9' | '_' -> () + | _ -> + failwith (sprintf "Character '%c' not allowed in function name '%s'" s.[i] s) done let parse_channel = @@ -125,7 +125,7 @@ let gen_normalize_ppm_iir = fun channels -> printf " _rc.values[RADIO_%s] = (pprz_t)((RADIO_FILTER * _rc.values[RADIO_%s] + tmp_value) / (RADIO_FILTER + 1));\\\n\\\n" c.name c.name else printf " _rc.values[RADIO_%s] = (pprz_t)(tmp_value);\\\n\\\n" c.name - ) + ) channels; (*printf " rc_values_contains_avg_channels = TRUE;\\\n";*) printf "}\n" diff --git a/sw/tools/gen_settings.ml b/sw/tools/gen_settings.ml index d9ba0a5f5a..32313bd37a 100644 --- a/sw/tools/gen_settings.ml +++ b/sw/tools/gen_settings.ml @@ -40,10 +40,10 @@ let rec flatten = fun xml r -> xml::r else 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 + [] -> r + | x::xs -> + 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) @@ -142,14 +142,14 @@ let print_dl_settings = fun settings -> left() (* - Generate code for persistent settings + Generate code for persistent settings *) let print_persistent_settings = fun settings -> let settings = flatten settings [] in let pers_settings = List.filter (fun x -> try let _ = Xml.attrib x "persistent" in true with _ -> false) settings in (* structure declaration *) -(* if List.length pers_settings > 0 then begin *) + (* if List.length pers_settings > 0 then begin *) lprintf "\n/* Persistent Settings */\n"; lprintf "struct PersistentSettings {\n"; right(); @@ -185,7 +185,7 @@ let print_persistent_settings = fun settings -> let h = ExtXml.attrib s "handler" and m = ExtXml.attrib s "module" in lprintf "%s_%s( pers_settings.s_%d );\n" (Filename.basename m) h !idx ; - (* lprintf "%s = pers_settings.s_%d;\n" v !idx *) (* do we want to set the value too or just call the handler ? *) + (* lprintf "%s = pers_settings.s_%d;\n" v !idx *) (* do we want to set the value too or just call the handler ? *) with ExtXml.Error e -> lprintf "%s = pers_settings.s_%d;\n" v !idx end; @@ -197,10 +197,10 @@ let print_persistent_settings = fun settings -> (* - Blaaaaaa2 + Blaaaaaa2 *) let calib_mode_of_rc = function - "gain_1_up" -> 1, "up" +"gain_1_up" -> 1, "up" | "gain_1_down" -> 1, "down" | "gain_2_up" -> 2, "up" | "gain_2_down" -> 2, "down" @@ -209,7 +209,7 @@ let calib_mode_of_rc = function let param_macro_of_type = fun x -> "ParamVal"^String.capitalize x let inttype = function - "int16" -> "int16_t" +"int16" -> "int16_t" | "float" -> "float" | x -> failwith (sprintf "Gen_calib.inttype: unknown type '%s'" x) @@ -221,7 +221,7 @@ let parse_rc_setting = fun xml -> let param_macro = param_macro_of_type t in let dot_pos = try String.rindex var '.' + 1 with - Not_found -> 0 in + Not_found -> 0 in let var_nostruct = String.sub var dot_pos (String.length var - dot_pos) in let var_init = var_nostruct ^ "_init" in @@ -259,7 +259,7 @@ let join_xml_files = fun xml_files -> Not_found -> [] in let these_dl_settings = try Xml.children (ExtXml.child xml "dl_settings") with - Not_found -> [] in + Not_found -> [] in rc_settings := these_rc_settings @ !rc_settings; dl_settings := these_dl_settings @ !dl_settings) xml_files; @@ -302,6 +302,6 @@ let _ = finish h_name with - Xml.Error e -> prerr_endline (Xml.error e); exit 1 - | Dtd.Prove_error e -> prerr_endline (Dtd.prove_error e); exit 1 - | Dtd.Parse_error e -> prerr_endline (Dtd.parse_error e); exit 1 + Xml.Error e -> prerr_endline (Xml.error e); exit 1 + | Dtd.Prove_error e -> prerr_endline (Dtd.prove_error e); exit 1 + | Dtd.Parse_error e -> prerr_endline (Dtd.parse_error e); exit 1 diff --git a/sw/tools/gen_srtm.ml b/sw/tools/gen_srtm.ml index af8e44f268..2f10ea555a 100644 --- a/sw/tools/gen_srtm.ml +++ b/sw/tools/gen_srtm.ml @@ -58,23 +58,23 @@ let () = () ) area_list; (* reading file names in dir *) - let file_names = Sys.readdir srtm_tmp_dir in + let file_names = Sys.readdir srtm_tmp_dir in (* Open temporary file *) - let file, out = Filename.open_temp_file ~temp_dir:var_dir "srtm" ".data" in + let file, out = Filename.open_temp_file ~temp_dir:var_dir "srtm" ".data" in (* Parse files for xml and read them *) - Array.iter (read_file_and_print out) file_names; + Array.iter (read_file_and_print out) file_names; (* Close file *) - close_out out; + close_out out; (* Compress file *) - let _ = Sys.command ("bzip2 -z "^file) in + let _ = Sys.command ("bzip2 -z "^file) in (* Move to final name *) - Unix.rename (file^".bz2") srtm_data; - prerr_endline ("Srtm data: "^srtm_data) + Unix.rename (file^".bz2") srtm_data; + prerr_endline ("Srtm data: "^srtm_data) diff --git a/sw/tools/gen_ubx.ml b/sw/tools/gen_ubx.ml index a18bf34cf5..f9509158fa 100644 --- a/sw/tools/gen_ubx.ml +++ b/sw/tools/gen_ubx.ml @@ -27,7 +27,7 @@ open Printf let out = stdout let sizeof = function - "U4" | "I4" -> 4 +"U4" | "I4" -> 4 | "U2" | "I2" -> 2 | "U1" | "I1" -> 1 | x -> failwith (sprintf "sizeof: unknown format '%s'" x) @@ -36,23 +36,23 @@ let (+=) = fun r x -> r := !r + x let c_type = fun format -> match format with - "I2" -> "int16_t" - | "I4" -> "int32_t" - | "U2" -> "uint16_t" - | "U4" -> "uint32_t" - | "U1" -> "uint8_t" - | "I1" -> "int8_t" - | _ -> failwith (sprintf "Gen_ubx.c_type: unknown format '%s'" format) + "I2" -> "int16_t" + | "I4" -> "int32_t" + | "U2" -> "uint16_t" + | "U4" -> "uint32_t" + | "U1" -> "uint8_t" + | "I1" -> "int8_t" + | _ -> failwith (sprintf "Gen_ubx.c_type: unknown format '%s'" format) let get_at = fun offset format block_size -> let t = c_type format in let block_offset = if block_size = 0 then "" else sprintf "+%d*_ubx_block" block_size in match format with - "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s)|*((uint8_t*)_ubx_payload+1+%d%s)<<8|((%s)*((uint8_t*)_ubx_payload+2+%d%s))<<16|((%s)*((uint8_t*)_ubx_payload+3+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset - | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s)|*((uint8_t*)_ubx_payload+1+%d%s)<<8)" t offset block_offset offset block_offset - | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s))" t offset block_offset - | _ -> failwith (sprintf "Gen_ubx.c_type: unknown format '%s'" format) + "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s)|*((uint8_t*)_ubx_payload+1+%d%s)<<8|((%s)*((uint8_t*)_ubx_payload+2+%d%s))<<16|((%s)*((uint8_t*)_ubx_payload+3+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset + | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s)|*((uint8_t*)_ubx_payload+1+%d%s)<<8)" t offset block_offset offset block_offset + | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s))" t offset block_offset + | _ -> failwith (sprintf "Gen_ubx.c_type: unknown format '%s'" format) let define = fun x y -> fprintf out "#define %s %s\n" x y @@ -75,19 +75,19 @@ let parse_message = fun class_name m -> let offset = ref 0 in let rec gen_access_macro = fun block_size f -> match Xml.tag f with - "field" -> - let fn = field_name f - and fmt = format f in - let block_no = if block_size = 0 then "" else ",_ubx_block" in - define (sprintf "UBX_%s_%s_%s(_ubx_payload%s)" class_name msg_name fn block_no) (get_at !offset fmt block_size); - offset += sizeof fmt - | "block" -> - let s = int_of_string (Xml.attrib f "length") in - let o = !offset in - List.iter (gen_access_macro s) (Xml.children f); - let s' = !offset - o in - if s <> s' then raise (Length_error (f, s, s')) - | x -> failwith ("Unexpected field: " ^ x) + "field" -> + let fn = field_name f + and fmt = format f in + let block_no = if block_size = 0 then "" else ",_ubx_block" in + define (sprintf "UBX_%s_%s_%s(_ubx_payload%s)" class_name msg_name fn block_no) (get_at !offset fmt block_size); + offset += sizeof fmt + | "block" -> + let s = int_of_string (Xml.attrib f "length") in + let o = !offset in + List.iter (gen_access_macro s) (Xml.children f); + let s' = !offset - o in + if s <> s' then raise (Length_error (f, s, s')) + | x -> failwith ("Unexpected field: " ^ x) in List.iter (gen_access_macro 0) (Xml.children m); @@ -96,7 +96,7 @@ let parse_message = fun class_name m -> let l = int_of_string (Xml.attrib m "length") in if l <> !offset then raise (Length_error (m, l, !offset)) with - Xml.No_attribute("length") -> () (** Undefined length authorized *) + Xml.No_attribute("length") -> () (** Undefined length authorized *) end; (** Generating send function *) @@ -113,14 +113,14 @@ let parse_message = fun class_name m -> fprintf out " UbxHeader(UBX_%s_ID, %s, %d);\\\n" class_name msg_id !offset; let rec send_one_field = fun f -> match Xml.tag f with - "field" -> - let s = sizeof (format f) in - let p = param_name f in - let t = param_type f in - fprintf out " %s _%s = %s; UbxSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p - | "block" -> - List.iter send_one_field (Xml.children f) - | _ -> assert (false) in + "field" -> + let s = sizeof (format f) in + let p = param_name f in + let t = param_type f in + fprintf out " %s _%s = %s; UbxSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p + | "block" -> + List.iter send_one_field (Xml.children f) + | _ -> assert (false) in List.iter send_one_field (Xml.children m); fprintf out " UbxTrailer();\\\n"; fprintf out "}\n" @@ -151,16 +151,16 @@ let _ = List.iter parse_class (Xml.children xml) with - Xml.Error (em, ep) -> - let l = Xml.line ep - and c1, c2 = Xml.range ep in - fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; - fprintf stderr "%s\n" (Xml.error_msg em); - exit 1 - | Length_error (m, l1, l2) -> + Xml.Error (em, ep) -> + let l = Xml.line ep + and c1, c2 = Xml.range ep in + fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; + fprintf stderr "%s\n" (Xml.error_msg em); + exit 1 + | Length_error (m, l1, l2) -> fprintf stderr "File \"%s\", inconsistent length: %d expected, %d found from fields in message:\n %s\n" xml_file l1 l2 (Xml.to_string_fmt m); exit 1 - | Dtd.Check_error e -> + | Dtd.Check_error e -> fprintf stderr "File \"%s\", DTD check error: %s\n" xml_file (Dtd.check_error e) - | Dtd.Prove_error e -> + | Dtd.Prove_error e -> fprintf stderr "\nFile \"%s\", DTD check error: %s\n\n" xml_file (Dtd.prove_error e) diff --git a/sw/tools/gen_xsens.ml b/sw/tools/gen_xsens.ml index 11543e1496..af5b665f1c 100644 --- a/sw/tools/gen_xsens.ml +++ b/sw/tools/gen_xsens.ml @@ -29,7 +29,7 @@ let out = stdout exception Variable_data let sizeof = function - "U32" -> 32 +"U32" -> 32 | "U8" -> 8 | "U4" | "I4" | "R4" -> 4 | "U2" | "I2" -> 2 @@ -39,20 +39,20 @@ let sizeof = function let (+=) = fun r x -> r := !r + x let test_type = function - "U32" | "U8" -> "skip" +"U32" | "U8" -> "skip" | "V" -> "variable" | _ -> "fixe" let c_type = fun format -> match format with - "R4" -> "float" - | "I4" -> "int32_t" - | "I2" -> "int16_t" - | "I1" -> "int8_t" - | "U4" -> "uint32_t" - | "U2" -> "uint16_t" - | "U1" -> "uint8_t" - | _ -> failwith (sprintf "Gen_xsens.c_type: unknown format '%s'" format) + "R4" -> "float" + | "I4" -> "int32_t" + | "I2" -> "int16_t" + | "I1" -> "int8_t" + | "U4" -> "uint32_t" + | "U2" -> "uint16_t" + | "U1" -> "uint8_t" + | _ -> failwith (sprintf "Gen_xsens.c_type: unknown format '%s'" format) (* format is BigEndian *) let get_at = fun offset format block_size -> @@ -60,11 +60,11 @@ let get_at = fun offset format block_size -> let block_offset = if block_size = 0 then "" else sprintf "+%d*_xsens_block" block_size in match format with - "R4" -> sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_xsens_payload+3+%d%s)|*((uint8_t*)_xsens_payload+2+%d%s)<<8|((uint32_t)*((uint8_t*)_xsens_payload+1+%d%s))<<16|((uint32_t)*((uint8_t*)_xsens_payload+%d%s))<<24); _f.f; })" offset block_offset offset block_offset offset block_offset offset block_offset - | "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+3+%d%s)|*((uint8_t*)_xsens_payload+2+%d%s)<<8|((%s)*((uint8_t*)_xsens_payload+1+%d%s))<<16|((%s)*((uint8_t*)_xsens_payload+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset - | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+1+%d%s)|*((uint8_t*)_xsens_payload+%d%s)<<8)" t offset block_offset offset block_offset - | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+%d%s))" t offset block_offset - | _ -> failwith (sprintf "Gen_xsens.c_type: unknown format '%s'" format) + "R4" -> sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_xsens_payload+3+%d%s)|*((uint8_t*)_xsens_payload+2+%d%s)<<8|((uint32_t)*((uint8_t*)_xsens_payload+1+%d%s))<<16|((uint32_t)*((uint8_t*)_xsens_payload+%d%s))<<24); _f.f; })" offset block_offset offset block_offset offset block_offset offset block_offset + | "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+3+%d%s)|*((uint8_t*)_xsens_payload+2+%d%s)<<8|((%s)*((uint8_t*)_xsens_payload+1+%d%s))<<16|((%s)*((uint8_t*)_xsens_payload+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset + | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+1+%d%s)|*((uint8_t*)_xsens_payload+%d%s)<<8)" t offset block_offset offset block_offset + | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+%d%s))" t offset block_offset + | _ -> failwith (sprintf "Gen_xsens.c_type: unknown format '%s'" format) let define = fun x y -> fprintf out "#define %s %s\n" x y @@ -88,25 +88,25 @@ let parse_message = fun m -> (** Generating read function *) let rec gen_read_macro = fun block_size f -> match Xml.tag f with - "field" -> - let fn = field_name f - and fmt = format f in - begin - match test_type (format f) with - "fixe" -> - let block_no = if block_size = 0 then "" else ",_xsens_block" in - define (sprintf "XSENS_%s_%s(_xsens_payload%s)" msg_name fn block_no) (get_at !offset fmt block_size); - offset += sizeof fmt; - | "variable" -> fprintf out "/* XSENS_%s_%s: variable data size */\n" msg_name fn; - | _ -> offset += sizeof fmt; - end - | "block" -> - let s = int_of_string (Xml.attrib f "length") in - let o = !offset in - List.iter (gen_read_macro s) (Xml.children f); - let s' = !offset - o in - if s <> s' then raise (Length_error (f, s, s')) - | x -> failwith ("Unexpected field: " ^ x) + "field" -> + let fn = field_name f + and fmt = format f in + begin + match test_type (format f) with + "fixe" -> + let block_no = if block_size = 0 then "" else ",_xsens_block" in + define (sprintf "XSENS_%s_%s(_xsens_payload%s)" msg_name fn block_no) (get_at !offset fmt block_size); + offset += sizeof fmt; + | "variable" -> fprintf out "/* XSENS_%s_%s: variable data size */\n" msg_name fn; + | _ -> offset += sizeof fmt; + end + | "block" -> + let s = int_of_string (Xml.attrib f "length") in + let o = !offset in + List.iter (gen_read_macro s) (Xml.children f); + let s' = !offset - o in + if s <> s' then raise (Length_error (f, s, s')) + | x -> failwith ("Unexpected field: " ^ x) in (** Generating send function *) @@ -128,15 +128,15 @@ let parse_message = fun m -> fprintf out " XsensHeader(%s, %s);\\\n" msg_id (get_msg_length m); let rec send_one_field = fun f -> match Xml.tag f with - "field" -> - let s = sizeof (format f) in - let p = param_name f in - let t = param_type f in - offset += sizeof (format f); - fprintf out " %s _%s = %s; XsensSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p - | "block" -> - List.iter send_one_field (Xml.children f) - | _ -> assert (false) in + "field" -> + let s = sizeof (format f) in + let p = param_name f in + let t = param_type f in + offset += sizeof (format f); + fprintf out " %s _%s = %s; XsensSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p + | "block" -> + List.iter send_one_field (Xml.children f) + | _ -> assert (false) in List.iter send_one_field (Xml.children m); fprintf out " XsensTrailer();\\\n"; fprintf out "}" @@ -144,9 +144,9 @@ let parse_message = fun m -> let gen_access_macro = match Xml.attrib m "to" with - "MT" -> gen_send_macro (); - | "host" -> List.iter (gen_read_macro 0) (Xml.children m); - | _ -> failwith "Unexpected direction"; + "MT" -> gen_send_macro (); + | "host" -> List.iter (gen_read_macro 0) (Xml.children m); + | _ -> failwith "Unexpected direction"; in gen_access_macro; @@ -155,7 +155,7 @@ let parse_message = fun m -> let l = int_of_string (Xml.attrib m "length") in if l <> !offset then raise (Length_error (m, l, !offset)) with - Xml.No_attribute("length") -> () (** Undefined length authorized *) + Xml.No_attribute("length") -> () (** Undefined length authorized *) end @@ -176,19 +176,19 @@ let parse_data = fun d -> (** Generating read function *) let gen_read_macro = fun f -> match Xml.tag f with - "field" -> - let fn = field_name f - and fdt = format f in - begin - match test_type (format f) with - "fixe" -> + "field" -> + let fn = field_name f + and fdt = format f in + begin + match test_type (format f) with + "fixe" -> (* _xsens_block used as offset value *) - define (sprintf "XSENS_DATA_%s_%s(_xsens_payload,_xsens_block)" data_name fn) (get_at !offset fdt 1); - offset += sizeof fdt; - | "variable" -> failwith (sprintf "XSENS_%s_%s: variable data size" data_name fn); - | _ -> offset += sizeof fdt; - end - | x -> failwith ("Unexpected field: " ^ x) + define (sprintf "XSENS_DATA_%s_%s(_xsens_payload,_xsens_block)" data_name fn) (get_at !offset fdt 1); + offset += sizeof fdt; + | "variable" -> failwith (sprintf "XSENS_%s_%s: variable data size" data_name fn); + | _ -> offset += sizeof fdt; + end + | x -> failwith ("Unexpected field: " ^ x) in List.iter gen_read_macro (Xml.children d); @@ -197,7 +197,7 @@ let parse_data = fun d -> let l = int_of_string (Xml.attrib d "length") in if l <> !offset then raise (Length_error (d, l, !offset)) with - Xml.No_attribute("length") -> () (** Undefined length authorized *) + Xml.No_attribute("length") -> () (** Undefined length authorized *) end let parse_mask = fun m -> @@ -211,10 +211,10 @@ let parse_mask = fun m -> let parse_all = fun m -> match Xml.tag m with - "message" -> parse_message m - | "data" -> parse_data m - | "mask" -> parse_mask m - | x -> failwith (sprintf "Unexpected tag: %s" x) + "message" -> parse_message m + | "data" -> parse_data m + | "mask" -> parse_mask m + | x -> failwith (sprintf "Unexpected tag: %s" x) @@ -234,18 +234,18 @@ let _ = List.iter parse_all (Xml.children xml) with - Xml.Error (em, ep) -> - let l = Xml.line ep - and c1, c2 = Xml.range ep in - fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; - fprintf stderr "%s\n" (Xml.error_msg em); - exit 1 - | Length_error (m, l1, l2) -> + Xml.Error (em, ep) -> + let l = Xml.line ep + and c1, c2 = Xml.range ep in + fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; + fprintf stderr "%s\n" (Xml.error_msg em); + exit 1 + | Length_error (m, l1, l2) -> fprintf stderr "File \"%s\", inconsistent length: %d expected, %d found from fields in message:\n %s\n" xml_file l1 l2 (Xml.to_string_fmt m); exit 1 - | Dtd.Parse_error e -> + | Dtd.Parse_error e -> fprintf stderr "File \"%s\", DTD parse error: %s\n" xml_file (Dtd.parse_error e) - | Dtd.Check_error e -> + | Dtd.Check_error e -> fprintf stderr "File \"%s\", DTD check error: %s\n" xml_file (Dtd.check_error e) - | Dtd.Prove_error e -> + | Dtd.Prove_error e -> fprintf stderr "\nFile \"%s\", DTD prove error: %s\n\n" xml_file (Dtd.prove_error e) diff --git a/sw/tools/wiki_gen/Makefile b/sw/tools/wiki_gen/Makefile index 766bb4b561..3bae53e3d4 100644 --- a/sw/tools/wiki_gen/Makefile +++ b/sw/tools/wiki_gen/Makefile @@ -46,4 +46,4 @@ OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring) $(Q)$(OCAMLYACC) $< clean: - rm -f *.cm* *.out *~ + $(Q)rm -f *.cm* *.out *~ diff --git a/tests/Makefile b/tests/Makefile index bdbbfa35c6..a06af1922a 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -28,5 +28,5 @@ test: $(Q)$(PERLENV) $(PERL) "-e" "$(RUNTESTS)" clean: - rm -rf results/* + $(Q)rm -rf results/*