Mirrors_Framework/paparazzi
1
0
Fork 0
mirror of https://github.com/paparazzi/paparazzi.git synced 2026-05-22 20:36:06 +08:00
Code Issues Actions 28 Packages Projects Releases Wiki Activity

Aircraft generator (#2545)

Browse Source 
* [ocaml] massive update of the build process
convert individual code generator to a single process, parsing everything once and calling the required generators
- remove all subsystems makefiles
- fix module name
- example of radio file without ctl attribute

* [build] start with flight plan to make semaphore happy
* [ocaml] move the buffer outside the lazy block
for some reason, it seems to make problems with compilation server
Semaphore
it really makes no sense, but nevermind...
This commit is contained in:
Gautier Hattenberger
2020-07-05 21:38:09 +02:00
committed by GitHub
parent e0a23a55c1
commit 09c0c8ccb9
70 changed files with 3168 additions and 2554 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Makefile.ac
+4 -109
View File
@@ -31,7 +31,6 @@ CONF=$(PAPARAZZI_HOME)/conf
VAR=$(PAPARAZZI_HOME)/var
CONF_XML ?= $(CONF)/conf.xml
AIRBORNE=sw/airborne
MESSAGES_XML = $(VAR)/messages.xml
# make sure the TARGET variable is set if needed for current make target
ifneq (,$(findstring $(MAKECMDGOALS),all_ac_h radio_ac_h flight_plan_ac_h))
@@ -50,35 +49,10 @@ endif
AIRCRAFT_CONF_DIR = $(AIRCRAFT_BUILD_DIR)/conf
AC_GENERATED = $(AIRCRAFT_BUILD_DIR)/$(TARGET)/generated
AIRFRAME_H=$(AC_GENERATED)/airframe.h
PERIODIC_H=$(AC_GENERATED)/periodic_telemetry.h
RADIO_H=$(AC_GENERATED)/radio.h
FLIGHT_PLAN_H=$(AC_GENERATED)/flight_plan.h
FLIGHT_PLAN_XML=$(AIRCRAFT_BUILD_DIR)/flight_plan.xml
SRCS_LIST=$(AIRCRAFT_BUILD_DIR)/$(TARGET)_srcs.list
TMP_LIST=$(AIRCRAFT_BUILD_DIR)/$(TARGET)_tmp.list
SETTINGS_H=$(AC_GENERATED)/settings.h
SETTINGS_XMLS=$(patsubst %,$(CONF)/%,$(SETTINGS))
SETTINGS_XMLS_DEP=$(filter-out %~,$(SETTINGS_XMLS))
SETTINGS_XML=$(AIRCRAFT_BUILD_DIR)/settings.xml
SETTINGS_MODULES=$(AIRCRAFT_BUILD_DIR)/settings_modules.xml
SETTINGS_TELEMETRY=$(AIRCRAFT_BUILD_DIR)/settings_telemetry.xml
SETTINGS_AUTOPILOT=$(AIRCRAFT_BUILD_DIR)/settings_autopilot.xml
SETTINGS_FLIGHTPLAN=$(AIRCRAFT_BUILD_DIR)/settings_flightplan.xml
MAKEFILE_AC=$(AIRCRAFT_BUILD_DIR)/Makefile.ac
MODULES_H=$(AC_GENERATED)/modules.h
MODULES_DIR=$(PAPARAZZI_HOME)/conf/modules/
AUTOPILOT_DIR=$(AC_GENERATED)/
AIRCRAFT_MD5=$(AIRCRAFT_CONF_DIR)/aircraft.md5
GENERATE_KEYS ?= 0
UNAME = $(shell uname -s)
ifeq ("$(UNAME)","Darwin")
MKTEMP = gmktemp
else
MKTEMP = mktemp
endif
# By default, detect number of processors for parallel compilation
# same as passing J=AUTO from toplevel make.
# Number of processes can also be explicitly set with e.g. J=4
@@ -155,7 +129,7 @@ print_version:
all_ac_h: $(SRCS_LIST) qt_project generate_keys build_rust_modules
$(SRCS_LIST) : $(CONF_XML) $(AIRFRAME_H) $(MODULES_H) $(SETTINGS_H) $(MAKEFILE_AC) $(PERIODIC_H)
$(SRCS_LIST):
@echo "TARGET: " $(TARGET) > $(SRCS_LIST)
@echo "CFLAGS: " $(CFLAGS) $(IINCDIR) $(TOPT) >> $(SRCS_LIST)
@echo "LDFLAGS: " $($(TARGET).LDFLAGS) >> $(SRCS_LIST)
@@ -223,105 +197,26 @@ ifneq ($(PAPARAZZI_QT_GEN),)
$(Q)./sw/tools/qt_project.py $(AIRCRAFT) $(CONF_XML) $(SRCS_LIST)
endif
radio_ac_h : $(RADIO_H)
flight_plan_ac_h : $(FLIGHT_PLAN_H) $(FLIGHT_PLAN_XML)
makefile_ac: $(MAKEFILE_AC)
$(AIRFRAME_H) : $(CONF)/$(AIRFRAME_XML) $(CONF_XML) $(AIRCRAFT_MD5) $(GENERATORS)/gen_airframe.out $(GENERATORS)/gen_autopilot.out $(CONF)/autopilot/*.xml
$(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED)
@echo GENERATE $@ from $(AIRFRAME_XML)
$(eval $@_TMP := $(shell $(MKTEMP)))
$(Q)$(GENERATORS)/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
@echo GENERATE autopilots in $(AUTOPILOT_DIR)
$(Q)$(GENERATORS)/gen_autopilot.out $(CONF)/$(AIRFRAME_XML) $(AUTOPILOT_DIR) $(SETTINGS_AUTOPILOT)
$(RADIO_H) : $(CONF)/$(RADIO) $(CONF_XML) $(GENERATORS)/gen_radio.out
$(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED)
@echo GENERATE $@ from $(RADIO)
$(eval $@_TMP := $(shell $(MKTEMP)))
$(Q)$(GENERATORS)/gen_radio.out $< > $($@_TMP)
$(Q)mv $($@_TMP) $@
$(Q)chmod a+r $@
$(Q)cp $< $(AIRCRAFT_CONF_DIR)/radios
$(PERIODIC_H) : $(MESSAGES_XML) $(CONF_XML) $(CONF)/$(TELEMETRY) $(MAKEFILE_AC)
$(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED)
@echo GENERATE $@ from $(TELEMETRY)
$(eval $@_TMP := $(shell $(MKTEMP)))
$(Q)$(GENERATORS)/gen_periodic.out $(MESSAGES_XML) $(CONF)/$(TELEMETRY) $(TELEMETRY_FREQUENCY) $(SETTINGS_TELEMETRY) > $($@_TMP)
$(Q)mv $($@_TMP) $@
$(Q)chmod a+r $@
$(Q)cp $(CONF)/$(TELEMETRY) $(AIRCRAFT_CONF_DIR)/telemetry
$(FLIGHT_PLAN_H) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(GENERATORS)/gen_flight_plan.out
$(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED)
@echo GENERATE $@ from $(FLIGHT_PLAN)
$(eval $@_TMP := $(shell $(MKTEMP)))
$(Q)$(GENERATORS)/gen_flight_plan.out -settings $(SETTINGS_FLIGHTPLAN) $< > $($@_TMP)
$(Q)mv $($@_TMP) $@
$(Q)chmod a+r $@
$(Q)cp $< $(AIRCRAFT_CONF_DIR)/flight_plans
$(FLIGHT_PLAN_XML) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(GENERATORS)/gen_flight_plan.out
@echo GENERATE $@ from $(FLIGHT_PLAN)
$(eval $@_TMP := $(shell $(MKTEMP)))
$(Q)$(GENERATORS)/gen_flight_plan.out -dump $< > $($@_TMP)
$(Q)mv $($@_TMP) $@
$(Q)chmod a+r $@
# split system settings (generated) from user settings with a '--'
$(SETTINGS_H) : $(SETTINGS_XMLS_DEP) $(CONF_XML) $(SETTINGS_MODULES) $(SETTINGS_TELEMETRY) $(SETTINGS_AUTOPILOT) $(GENERATORS)/gen_settings.out
$(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED)
@echo GENERATE $@
$(eval $@_TMP := $(shell $(MKTEMP)))
$(Q)$(GENERATORS)/gen_settings.out $(SETTINGS_XML) $(SETTINGS_AUTOPILOT) $(SETTINGS_TELEMETRY) $(SETTINGS_FLIGHTPLAN) $(SETTINGS_MODULES) -- $(SETTINGS_XMLS) > $($@_TMP)
$(Q)mv $($@_TMP) $@
$(Q)chmod a+r $@
$(Q)cp $(SETTINGS_XMLS_DEP) $(AIRCRAFT_CONF_DIR)/settings
$(MODULES_H) : $(CONF)/$(AIRFRAME_XML) $(FLIGHT_PLAN_XML) $(GENERATORS)/gen_modules.out $(CONF)/modules/*.xml
$(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED)
@echo GENERATE $@
$(eval $@_TMP := $(shell $(MKTEMP)))
$(Q)$(GENERATORS)/gen_modules.out $(AC_ID) $(SETTINGS_MODULES) $(DEFAULT_MODULES_FREQUENCY) $(FLIGHT_PLAN_XML) $< > $($@_TMP)
$(Q)mv $($@_TMP) $@
$(Q)chmod a+r $@
$(SETTINGS_MODULES) : $(MODULES_H)
$(SETTINGS_TELEMETRY) : $(PERIODIC_H)
$(SETTINGS_FLIGHTPLAN) : $(FLIGHT_PLAN_H)
%.ac_h : $(GENERATORS)/gen_aircraft.out
$(Q)if (expr "$(AIRCRAFT)") > /dev/null; then : ; else echo "AIRCRAFT undefined: type 'make AIRCRAFT=AircraftName ...'"; exit 1; fi
@echo "#######################################"
@echo "# BUILD AIRCRAFT=$(AIRCRAFT), TARGET $*"
@echo "#######################################"
$(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) PAPARAZZI_QT_GEN=$(PAPARAZZI_QT_GEN) TARGET=$* Q=$(Q) $(GENERATORS)/gen_aircraft.out $(AIRCRAFT) $(CONF_XML)
$(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) PAPARAZZI_QT_GEN=$(PAPARAZZI_QT_GEN) TARGET=$* Q=$(Q) $(GENERATORS)/gen_aircraft.out -all -name $(AIRCRAFT) -target $* -conf $(CONF_XML)
%.qt: %.ac_h
@echo "GENERATED Qt project"
%.compile: %.ac_h | print_version
$(MAKE) TARGET=$* -f Makefile.ac all_ac_h
cd $(AIRBORNE); $(MAKE) -j$(NPROCS) TARGET=$* all
%.upload: %.compile
cd $(AIRBORNE); $(MAKE) TARGET=$* upload
sim sim.compile: sim.ac_h | print_version
cd $(AIRBORNE); $(MAKE) -j$(NPROCS) TARGET=sim ARCHI=sim ARCH=sim all
# Rules for backward compatibility (old guys are used to !)
fbw : fbw.compile
ap: ap.compile
clean_ac :
$(Q)if (expr "$(AIRCRAFT)") > /dev/null; then : ; else echo "AIRCRAFT undefined: type 'make AIRCRAFT=AircraftName ...'"; exit 1; fi
@echo "CLEANING $(AIRCRAFT)"
$(Q)rm -fr $(AIRCRAFT_BUILD_DIR)
.PHONY: all_ac_h radio_ac_h flight_plan_ac_h makefile_ac clean_ac print_version generate_keys
.PHONY: all_ac_h clean_ac print_version generate_keys
conf/airframes/airframe.dtd
+6 -31
View File
@@ -1,6 +1,6 @@
<!-- Paparazzi airframe DTD -->
<!ELEMENT airframe (include|servos|commands|rc_commands|auto_rc_commands|ap_only_commands|command_laws|section|makefile|modules|firmware|autopilot|heli_curves|description)*>
<!ELEMENT airframe (include|servos|commands|rc_commands|auto_rc_commands|ap_only_commands|command_laws|section|modules|firmware|autopilot|heli_curves|description)*>
<!ELEMENT include EMPTY>
<!ELEMENT servos (servo)*>
<!ELEMENT commands (axis)*>
@@ -9,7 +9,7 @@
<!ELEMENT ap_only_commands (copy)*>
<!ELEMENT command_laws (let|set|call|ratelimit)*>
<!ELEMENT heli_curves (curve)*>
<!ELEMENT section (define|linear|comment)*>
<!ELEMENT section (define|comment)*>
<!ELEMENT servo EMPTY>
<!ELEMENT axis EMPTY>
<!ELEMENT set EMPTY>
@@ -19,14 +19,10 @@
<!ELEMENT curve EMPTY>
<!ELEMENT let EMPTY>
<!ELEMENT define EMPTY>
<!ELEMENT linear EMPTY>
<!ELEMENT makefile (#PCDATA)>
<!ELEMENT modules (load|module)*>
<!ELEMENT load (configure|define)*>
<!ELEMENT modules (module)*>
<!ELEMENT configure EMPTY>
<!ELEMENT firmware (target|subsystem|module|autopilot|configure|define|comment)*>
<!ELEMENT target (subsystem|module|autopilot|configure|define|comment)*>
<!ELEMENT subsystem (configure|define|comment)*>
<!ELEMENT firmware (target|module|autopilot|configure|define|comment)*>
<!ELEMENT target (module|autopilot|configure|define|comment)*>
<!ELEMENT module (configure|define|comment)*>
<!ELEMENT autopilot EMPTY>
<!ELEMENT comment (#PCDATA)>
@@ -44,12 +40,7 @@ freq CDATA #IMPLIED>
<!ATTLIST target
name CDATA #REQUIRED
board CDATA #REQUIRED
processor CDATA #IMPLIED>
<!ATTLIST subsystem
name CDATA #REQUIRED
type CDATA #IMPLIED>
board CDATA #REQUIRED>
<!ATTLIST airframe
name CDATA #IMPLIED>
@@ -119,26 +110,10 @@ name CDATA #REQUIRED
value CDATA #REQUIRED
description CDATA #IMPLIED>
<!ATTLIST linear
name CDATA #REQUIRED
arity CDATA #REQUIRED
coeff1 CDATA #REQUIRED
coeff2 CDATA #IMPLIED
coeff3 CDATA #IMPLIED>
<!ATTLIST makefile
target CDATA #IMPLIED
location CDATA #IMPLIED>
<!ATTLIST modules
main_freq CDATA #IMPLIED
target CDATA #IMPLIED>
<!ATTLIST load
name CDATA #REQUIRED
target CDATA #IMPLIED
dir CDATA #IMPLIED>
<!ATTLIST module
name CDATA #REQUIRED
type CDATA #IMPLIED
conf/autopilot/autopilot.dtd
+4 -3
View File
@@ -14,8 +14,8 @@
<!ELEMENT include EMPTY>
<!ELEMENT call EMPTY>
<!ELEMENT call_block EMPTY>
<!ELEMENT modules (load)*>
<!ELEMENT load (configure|define)*>
<!ELEMENT modules (module)*>
<!ELEMENT module (configure|define)*>
<!ELEMENT define EMPTY>
<!ELEMENT configure EMPTY>
<!ELEMENT settings (dl_setting*)>
@@ -72,8 +72,9 @@ name CDATA #REQUIRED>
<!ATTLIST modules>
<!ATTLIST load
<!ATTLIST module
name CDATA #REQUIRED
type CDATA #IMPLIED
target CDATA #IMPLIED>
<!ATTLIST define
conf/firmwares/subsystems/fixedwing/navigation_extra.makefile
-7
View File
@@ -1,7 +0,0 @@
include $(CFG_FIXEDWING)/navigation.makefile
$(warning Warning: Extra navigation routines have been converted to modules.)
$(info Please replace <subsystem name="navigation" type="extra"/> with <subsystem name="navigation"/>)
conf/firmwares/subsystems/rotorcraft/gps_datalink.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: The gps datalink subsystem has been converted to a module, replace <subsystem name="gps" type="datalink"/> by <module name="gps" type="datalink"/>)
conf/firmwares/subsystems/rotorcraft/gps_sim_hitl.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: replace <subsystem name="gps" type="sim_hitl"/> by <module name="gps" type="sim_hitl"/>)
conf/firmwares/subsystems/rotorcraft/gps_sirf.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: The gps sirf subsystem has been converted to a module, replace <subsystem name="gps" type="sirf"/> by <module name="gps" type="sirf"/>)
conf/firmwares/subsystems/rotorcraft/gps_udp.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: The gps udp subsystem has been converted to a module, replace <subsystem name="gps" type="udp"/> by <module name="gps" type="udp"/>)
conf/firmwares/subsystems/shared/gps_furuno.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: The gps furuno subsystem has been converted to a module, replace <subsystem name="gps" type="furuno"/> by <module name="gps" type="furuno"/>)
conf/firmwares/subsystems/shared/gps_mediatek_diy.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: The gps mediatek subsystem has been converted to a module, replace <subsystem name="gps" type="mediatek_diy"/> by <module name="gps" type="mediatek_diy"/>)
conf/firmwares/subsystems/shared/gps_nmea.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: The gps nmea subsystem has been converted to a module, replace <subsystem name="gps" type="nmea"/> with <module name="gps" type="nmea"/>)
conf/firmwares/subsystems/shared/gps_piksi.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: The gps piksi subsystem has been converted to a module, replace <subsystem name="gps" type="piksi"/> by <module name="gps" type="piksi"/>)
conf/firmwares/subsystems/shared/gps_skytraq.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: The gps skytraq subsystem has been converted to a module, replace <subsystem name="gps" type="skytraq"/> by <module name="gps" type="skytraq"/>)
conf/firmwares/subsystems/shared/gps_ublox.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: The gps ublox subsystem has been converted to a module, replace <subsystem name="gps" type="ublox"/> by <module name="gps" type="ublox"/>)
conf/firmwares/subsystems/shared/gps_ublox_utm.makefile
-1
View File
@@ -1 +0,0 @@
$(error Please replace <subsystem name="gps" type="ublox_utm"/> with <module name="gps" type="ublox"/>)
conf/firmwares/subsystems/shared/sdlog.makefile
-1
View File
@@ -1 +0,0 @@
$(error Error: The sdlog subsystem has been replaced by a module and renamed pprzlog, replace <subsystem name="sdlog"/> by <module name="pprzlog"/>)
conf/modules/nav_line.xml
+1 -1
View File
@@ -1,6 +1,6 @@
<!DOCTYPE module SYSTEM "module.dtd">
<module name="nav_smooth" dir="nav">
<module name="nav_line" dir="nav">
<doc>
<description>
Fixedwing navigation along a line with nice U-turns.
conf/radios/T14SG_SBUS.xml
+13 -13
View File
@@ -44,17 +44,17 @@
-->
<!DOCTYPE radio SYSTEM "radio.dtd">
<radio name="Futaba T14SG with SBUS" data_min="900" data_max="2100" sync_min ="5000" sync_max ="15000" pulse_type="POSTIVE">
<channel ctl="A" function="ROLL" min="1000" neutral="1500" max="2000" average="0"/>
<channel ctl="B" function="PITCH" min="1000" neutral="1500" max="2000" average="0"/>
<channel ctl="C" function="THROTTLE" min="1000" neutral="1000" max="2000" average="0"/>
<channel ctl="D" function="YAW" min="1000" neutral="1500" max="2000" average="0"/>
<channel ctl="E" function="UNUSED1" max="1000" neutral="1500" min="2000" average="1"/>
<channel ctl="F" function="KILL" min="1000" neutral="1500" max="2000" average="0"/>
<channel ctl="G" function="AUX2" min="1000" neutral="1500" max="2000" average="0"/>
<channel ctl="H" function="MODE" min="1000" neutral="1500" max="2000" average="0"/>
<channel ctl="I" function="UNUSED3" min="1000" neutral="1500" max="2000" average="0"/>
<channel ctl="J" function="AUX3" min="1000" neutral="1500" max="2000" average="0"/>
<channel ctl="K" function="UNUSED5" min="1000" neutral="1500" max="2000" average="0"/>
<channel ctl="L" function="UNUSED6" min="1000" neutral="1500" max="2000" average="0"/>
<radio name="Futaba T14SG with SBUS" data_min="900" data_max="2100" sync_min ="5000" sync_max ="15000" pulse_type="POSITIVE">
<channel function="ROLL" min="1000" neutral="1500" max="2000" average="0"/>
<channel function="PITCH" min="1000" neutral="1500" max="2000" average="0"/>
<channel function="THROTTLE" min="1000" neutral="1000" max="2000" average="0"/>
<channel function="YAW" min="1000" neutral="1500" max="2000" average="0"/>
<channel function="UNUSED1" max="1000" neutral="1500" min="2000" average="1"/>
<channel function="KILL" min="1000" neutral="1500" max="2000" average="0"/>
<channel function="AUX2" min="1000" neutral="1500" max="2000" average="0"/>
<channel function="MODE" min="1000" neutral="1500" max="2000" average="0"/>
<channel function="UNUSED3" min="1000" neutral="1500" max="2000" average="0"/>
<channel function="AUX3" min="1000" neutral="1500" max="2000" average="0"/>
<channel function="UNUSED5" min="1000" neutral="1500" max="2000" average="0"/>
<channel function="UNUSED6" min="1000" neutral="1500" max="2000" average="0"/>
</radio>
conf/radios/cockpitMM.xml
+7 -7
View File
@@ -44,11 +44,11 @@
<!DOCTYPE radio SYSTEM "radio.dtd">
<radio name="cockpitMM" data_min="900" data_max="2100" sync_min ="5000" sync_max ="15000" pulse_type="POSITIVE">
<channel ctl="D" function="ROLL" min="2000" neutral="1498" max="1000" average="0"/>
<channel ctl="C" function="PITCH" min="2000" neutral="1498" max="1000" average="0"/>
<channel ctl="B" function="YAW" min="2000" neutral="1498" max="1000" average="0"/>
<channel ctl="A" function="THROTTLE" min="1120" neutral="1120" max="2000" average="0"/>
<channel ctl="G" function="GAIN1" min="2000" neutral="1498" max="1000" average="1"/> <!-- center slider -->
<channel ctl="E" function="MODE" min="2000" neutral="1500" max="1000" average="1"/> <!-- Top right switch -->
<channel ctl="F" function="CALIB" min="2000" neutral="1500" max="1000" average="1"/> <!-- Top left rotary knob -->
<channel function="ROLL" min="2000" neutral="1498" max="1000" average="0"/>
<channel function="PITCH" min="2000" neutral="1498" max="1000" average="0"/>
<channel function="YAW" min="2000" neutral="1498" max="1000" average="0"/>
<channel function="THROTTLE" min="1120" neutral="1120" max="2000" average="0"/>
<channel function="GAIN1" min="2000" neutral="1498" max="1000" average="1"/> <!-- center slider -->
<channel function="MODE" min="2000" neutral="1500" max="1000" average="1"/> <!-- Top right switch -->
<channel function="CALIB" min="2000" neutral="1500" max="1000" average="1"/> <!-- Top left rotary knob -->
</radio>
conf/radios/radio.dtd
+3 -2
View File
@@ -12,9 +12,10 @@
pulse_type CDATA #REQUIRED>
<!ATTLIST channel
ctl CDATA #REQUIRED
ctl CDATA #IMPLIED
function CDATA #REQUIRED
min CDATA #REQUIRED
neutral CDATA #REQUIRED
max CDATA #REQUIRED
average CDATA #REQUIRED>
average CDATA #IMPLIED
reverse CDATA #IMPLIED>
conf/settings/settings.dtd
+8 -14
View File
@@ -1,20 +1,9 @@
<!-- Dataling and RC settings DTD -->
<!ELEMENT settings (rc_settings?,dl_settings?)>
<!ELEMENT rc_settings (rc_mode*)>
<!ELEMENT rc_mode (rc_setting*)>
<!ELEMENT rc_setting EMPTY>
<!ATTLIST rc_mode name CDATA #REQUIRED>
<!ATTLIST rc_setting var CDATA #REQUIRED>
<!ATTLIST rc_setting type (int16|float) #REQUIRED>
<!ATTLIST rc_setting range CDATA #REQUIRED>
<!ATTLIST rc_setting rc (gain_1_up|gain_2_up|gain_1_down|gain_2_down) #REQUIRED>
<!ELEMENT dl_settings (dl_setting|dl_settings)+>
<!ELEMENT settings (dl_settings?)>
<!ELEMENT dl_settings (dl_setting|dl_settings|include)+>
<!ELEMENT dl_setting (strip_button|key_press)*>
<!ELEMENT include EMPTY>
<!ELEMENT strip_button EMPTY>
<!ELEMENT key_press EMPTY>
@@ -26,6 +15,10 @@ target CDATA #IMPLIED
name CDATA #IMPLIED
>
<!ATTLIST include
header CDATA #REQUIRED
>
<!ATTLIST dl_setting
var CDATA #REQUIRED
min CDATA #REQUIRED
@@ -35,6 +28,7 @@ step CDATA #IMPLIED
widget CDATA #IMPLIED
shortname CDATA #IMPLIED
module CDATA #IMPLIED
header CDATA #IMPLIED
handler CDATA #IMPLIED
param CDATA #IMPLIED
unit CDATA #IMPLIED
conf/telemetry/telemetry.dtd
+2 -1
View File
@@ -14,6 +14,7 @@
>
<!ATTLIST message
name CDATA #REQUIRED
period CDATA #REQUIRED
period CDATA #IMPLIED
freq CDATA #IMPLIED
phase CDATA #IMPLIED
>
sw/airborne/arch/sim/subsystems/radio_control/spektrum_arch.c
+1
View File
@@ -28,6 +28,7 @@
#include "subsystems/radio_control.h"
#include "subsystems/radio_control/spektrum_arch.h"
#include "subsystems/radio_control/spektrum.h"
#include "std.h"
#include <inttypes.h>
sw/airborne/arch/sim/subsystems/radio_control/spektrum_arch.h
-2
View File
@@ -25,9 +25,7 @@
#include "subsystems/radio_control/spektrum_radio.h"
extern void spektrum_event(void (*_received_frame_handler)(void));
#define RadioControlEventImp spektrum_event
extern void spektrum_try_bind(void);
#if USE_NPS
extern void radio_control_feed(void);
sw/ground_segment/cockpit/live.ml
+1 -1
View File
@@ -470,7 +470,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
(* do not check dtd if it is a http url *)
let via_http = Str.string_match (Str.regexp "http") af_url 0 in
let af_xml = ExtXml.parse_file ~noprovedtd:via_http af_file in
let af_xml = try Gen_common.expand_includes ac_id af_xml with _ -> af_xml in
let af_xml = try Airframe.expand_includes ac_id af_xml with _ -> af_xml in
(** Get an alternate speech name if available *)
let speech_name = get_speech_name af_xml name in
sw/ground_segment/tmtc/Makefile
+4 -4
View File
@@ -34,7 +34,7 @@ LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz,pprzlink
XPKG = -package pprz.xlib
XLINKPKG = $(XPKG) -linkpkg -dllpath-pkg pprz.xlib,pprzlink
SERVERCMO = server_globals.cmo aircraft.cmo wind.cmo airprox.cmo kml.cmo parse_messages_v1.ml intruder.cmo server.cmo
SERVERCMO = server_globals.cmo aircraft_server.cmo wind.cmo airprox.cmo kml.cmo parse_messages_v1.ml intruder.cmo server.cmo
SERVERCMX = $(SERVERCMO:.cmo=.cmx)
@@ -49,7 +49,7 @@ messages : messages.cmo $(LIBPPRZCMA) $(LIBPPRZLINKCMA)
@echo OL $@
$(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $<
settings : settings.cmo ../cockpit/page_settings.cmo $(LIBPPRZCMA) $(LIBPPRZLINKCMA)
settings : settings_gui.cmo ../cockpit/page_settings.cmo $(LIBPPRZCMA) $(LIBPPRZLINKCMA)
@echo OL $@
$(Q)$(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo -I ../cockpit gtk_save_settings.cmo saveSettings.cmo page_settings.cmo $<
@@ -94,8 +94,8 @@ ivy2serial : ivy2serial.cmo $(LIBPPRZCMA) $(LIBPPRZLINKCMA)
@echo OL $@
$(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $<
settings.cmo : INCLUDES += -I ../cockpit
settings.cmo : ../cockpit/page_settings.cmi
settings_gui.cmo : INCLUDES += -I ../cockpit
settings_gui.cmo : ../cockpit/page_settings.cmi
%.cmo : %.ml
@echo OC $<
sw/ground_segment/tmtc/aircraft.ml → sw/ground_segment/tmtc/aircraft_server.ml
View File
sw/ground_segment/tmtc/aircraft.mli → sw/ground_segment/tmtc/aircraft_server.mli
View File
sw/ground_segment/tmtc/airprox.ml
+1 -1
View File
@@ -22,7 +22,7 @@
*
*)
open Aircraft
open Aircraft_server
open Latlong
module Alerts_Pprz = PprzLink.Messages(struct let name = "alert" end)
sw/ground_segment/tmtc/airprox.mli
+1 -1
View File
@@ -23,5 +23,5 @@
*)
type alert_level = string option
val check_airprox : Aircraft.aircraft -> Aircraft.aircraft -> alert_level
val check_airprox : Aircraft_server.aircraft -> Aircraft_server.aircraft -> alert_level
(** [check_airprox ac1 ac2] Returns airprox level *)
sw/ground_segment/tmtc/kml.ml
+1 -1
View File
@@ -23,7 +23,7 @@
*)
open Aircraft
open Aircraft_server
open Latlong
open Printf
open Server_globals
sw/ground_segment/tmtc/kml.mli
+4 -4
View File
@@ -24,8 +24,8 @@
val enabled : bool ref
val no_http : bool ref
val build_files : Aircraft.aircraft -> unit
val update_waypoints : Aircraft.aircraft -> unit
val update_horiz_mode : Aircraft.aircraft -> unit
val update_ac : Aircraft.aircraft -> unit
val build_files : Aircraft_server.aircraft -> unit
val update_waypoints : Aircraft_server.aircraft -> unit
val update_horiz_mode : Aircraft_server.aircraft -> unit
val update_ac : Aircraft_server.aircraft -> unit
sw/ground_segment/tmtc/parse_messages_v1.ml
+9 -9
View File
@@ -24,7 +24,7 @@
open Printf
open Server_globals
open Aircraft
open Aircraft_server
open Latlong
module LL = Latlong
module U = Unix
@@ -132,7 +132,7 @@ let hmsl_of_ref = fun nav_ref d_hmsl ->
let heading_from_course = ref false
let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values ->
let log_and_parse = fun ac_name (a:Aircraft_server.aircraft) msg values ->
let value = fun x -> try PprzLink.assoc x values with Not_found -> failwith (sprintf "Error: field '%s' not found\n" x) in
let fvalue = fun x ->
@@ -207,7 +207,7 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values ->
let desired_east = foi32value "carrot_east" /. pos_frac
and desired_north = foi32value "carrot_north" /. pos_frac
and desired_alt = foi32value "carrot_up" /. pos_frac in
a.desired_pos <- Aircraft.add_pos_to_nav_ref nav_ref ~z:desired_alt (desired_east, desired_north);
a.desired_pos <- Aircraft_server.add_pos_to_nav_ref nav_ref ~z:desired_alt (desired_east, desired_north);
a.desired_altitude <- desired_alt +. (hmsl_of_ref nav_ref a.d_hmsl);
a.desired_course <- foi32value "carrot_psi" /. angle_frac
(* a.desired_climb <- ?? *)
@@ -246,7 +246,7 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values ->
Some nav_ref ->
let x = (try fvalue "x" with _ -> fvalue "desired_x")
and y = (try fvalue "y" with _ -> fvalue "desired_y") in
a.desired_pos <- Aircraft.add_pos_to_nav_ref nav_ref (x, y);
a.desired_pos <- Aircraft_server.add_pos_to_nav_ref nav_ref (x, y);
| None -> ()
end;
a.desired_altitude <- (try fvalue "altitude" with _ -> fvalue "desired_altitude");
@@ -401,7 +401,7 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values ->
begin
match a.nav_ref, a.horizontal_mode with
Some nav_ref, 2 -> (** FIXME *)
a.horiz_mode <- Circle (Aircraft.add_pos_to_nav_ref nav_ref (fvalue "center_east", fvalue "center_north"), truncate (fvalue "radius"));
a.horiz_mode <- Circle (Aircraft_server.add_pos_to_nav_ref nav_ref (fvalue "center_east", fvalue "center_north"), truncate (fvalue "radius"));
if !Kml.enabled then Kml.update_horiz_mode a
| _ -> ()
end
@@ -409,8 +409,8 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values ->
begin
match a.nav_ref, a.horizontal_mode with
Some nav_ref, 1 -> (** FIXME *)
let p1 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "segment_east_1", fvalue "segment_north_1")
and p2 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "segment_east_2", fvalue "segment_north_2") in
let p1 = Aircraft_server.add_pos_to_nav_ref nav_ref (fvalue "segment_east_1", fvalue "segment_north_1")
and p2 = Aircraft_server.add_pos_to_nav_ref nav_ref (fvalue "segment_east_2", fvalue "segment_north_2") in
a.horiz_mode <- Segment (p1, p2);
if !Kml.enabled then Kml.update_horiz_mode a
| _ -> ()
@@ -423,8 +423,8 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values ->
a.time_since_last_survey_msg <- 0.;
match a.nav_ref with
Some nav_ref ->
let p1 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "west", fvalue "south")
and p2 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "east", fvalue "north") in
let p1 = Aircraft_server.add_pos_to_nav_ref nav_ref (fvalue "west", fvalue "south")
and p2 = Aircraft_server.add_pos_to_nav_ref nav_ref (fvalue "east", fvalue "north") in
a.survey <- Some (p1, p2)
| None -> ()
end
sw/ground_segment/tmtc/parse_messages_v1.mli
+1 -1
View File
@@ -23,6 +23,6 @@
*)
val log_and_parse :
string -> Aircraft.aircraft -> PprzLink.message -> PprzLink.values -> unit
string -> Aircraft_server.aircraft -> PprzLink.message -> PprzLink.values -> unit
(** [log_and_parse ac_id ac msg vs] *)
sw/ground_segment/tmtc/server.ml
+14 -9
View File
@@ -31,7 +31,7 @@ let replay_old_log = ref false
open Printf
open Latlong
open Server_globals
open Aircraft
open Aircraft_server
open Quaternion
(*open Intruder*)
module U = Unix
@@ -69,7 +69,9 @@ let send_aircrafts_msg = fun _asker _values ->
let expand_aicraft x =
let ac_name = ExtXml.attrib x "name" in
try
Env.expand_ac_xml x
let ac = Aircraft.parse_aircraft ~parse_all:true "" x in
if List.length ac.Aircraft.xml > 0 then Xml.Element (Xml.tag x, Xml.attribs x, ac.Aircraft.xml)
else failwith "Nothing to parse"
with Failure msg ->
begin
prerr_endline ("A failure occurred while processing aircraft '"^ac_name^"'");
@@ -193,7 +195,7 @@ let send_cam_status = fun a ->
let utmx = dx *. cos angles.y -. dy *. sin angles.y
and utmy = dx *. sin angles.y +. dy *. cos angles.y in
Aircraft.add_pos_to_nav_ref (Geo a.pos) (utmx, utmy) in
Aircraft_server.add_pos_to_nav_ref (Geo a.pos) (utmx, utmy) in
let geo_1 = find_point_on_ground tr_rotated
and geo_2 = find_point_on_ground tl_rotated
@@ -203,7 +205,7 @@ let send_cam_status = fun a ->
let lats = sprintf "%f,%f,%f,%f," ((Rad>>Deg)geo_1.posn_lat) ((Rad>>Deg)geo_2.posn_lat) ((Rad>>Deg)geo_3.posn_lat) ((Rad>>Deg)geo_4.posn_lat) in
let longs = sprintf "%f,%f,%f,%f," ((Rad>>Deg)geo_1.posn_long) ((Rad>>Deg)geo_2.posn_long) ((Rad>>Deg)geo_3.posn_long) ((Rad>>Deg)geo_4.posn_long) in
let twgs84 = Aircraft.add_pos_to_nav_ref nav_ref a.cam.target in
let twgs84 = Aircraft_server.add_pos_to_nav_ref nav_ref a.cam.target in
let values = ["ac_id", PprzLink.String a.id;
"lats", PprzLink.String lats;
"longs", PprzLink.String longs;
@@ -327,7 +329,7 @@ let send_telemetry_status = fun a ->
(* if no link send anyway for rx_lost_time with special link id *)
if Hashtbl.length a.link_status = 0 then
begin
let vs = tl_payload "no_id" a.datalink_status (Aircraft.link_status_init ()) in
let vs = tl_payload "no_id" a.datalink_status (Aircraft_server.link_status_init ()) in
Ground_Pprz.message_send my_id "TELEMETRY_STATUS" vs
end
else
@@ -555,15 +557,18 @@ let new_aircraft = fun get_alive_md5sum real_id ->
if not is_replayed then
check_md5sum real_id (get_alive_md5sum ()) aircraft_conf_dir;
let ac = Aircraft.new_aircraft real_id ac_name xml_fp airframe_xml in
let ac = Aircraft_server.new_aircraft real_id ac_name xml_fp airframe_xml in
let update = fun () ->
for i = 0 to Array.length ac.svinfo - 1 do
ac.svinfo.(i).age <- ac.svinfo.(i).age + 1;
done in
ignore (ac.ap_modes <- try
let (ap_file, _) = Gen_common.get_autopilot_of_airframe airframe_xml in
Some (modes_from_autopilot (ExtXml.parse_file ap_file))
let ac = Aircraft.parse_aircraft "" airframe_xml in
match ac.Aircraft.autopilots with
| None -> None
| Some [(_, ap)] -> Some (modes_from_autopilot ap.Autopilot.xml)
| _ -> None (* more than one *)
with _ -> None);
ignore (Glib.Timeout.add 1000 (fun _ -> update (); true));
@@ -846,7 +851,7 @@ let link_report = fun logging _sender vs ->
try
let ac = Hashtbl.find aircrafts ac_id in
let link_status = {
Aircraft.rx_lost_time = PprzLink.int_assoc "rx_lost_time" vs;
Aircraft_server.rx_lost_time = PprzLink.int_assoc "rx_lost_time" vs;
rx_bytes = PprzLink.int_assoc "rx_bytes" vs;
rx_msgs = PprzLink.int_assoc "rx_msgs" vs;
rx_bytes_rate = PprzLink.float_assoc "rx_bytes_rate" vs;
sw/ground_segment/tmtc/settings.ml → sw/ground_segment/tmtc/settings_gui.ml
View File
sw/lib/ocaml/Makefile
+2 -1
View File
@@ -68,7 +68,8 @@ PKGCOMMON=pprzlink,xml-light,netclient,nettls-gnutls,glibivy,lablgtk2
XINCLUDES=
XPKGCOMMON=pprzlink,xml-light,glibivy,$(LABLGTK2GNOMECANVAS),lablgtk2.glade
SRC = compat.ml fig.ml debug.ml base64.ml serial.ml ocaml_tools.ml expr_syntax.ml expr_parser.ml expr_lexer.ml extXml.ml env.ml xml2h.ml latlong.ml egm96.ml srtm.ml http.ml maps_support.ml gm.ml iGN.ml geometry_2d.ml cserial.o ubx.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml fp_proc.ml gen_common.ml quaternion.ml
SRC = compat.ml fig.ml debug.ml base64.ml serial.ml ocaml_tools.ml expr_syntax.ml expr_parser.ml expr_lexer.ml extXml.ml env.ml xml2h.ml latlong.ml egm96.ml srtm.ml http.ml maps_support.ml gm.ml iGN.ml geometry_2d.ml cserial.o ubx.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml fp_proc.ml quaternion.ml
SRC += gen_common.ml radio.ml settings.ml module.ml flight_plan.ml autopilot.ml airframe.ml telemetry.ml aircraft.ml
CMO = $(SRC:.ml=.cmo)
CMX = $(SRC:.ml=.cmx)
sw/lib/ocaml/aircraft.ml
+379
View File
@@ -0,0 +1,379 @@
(*
* Copyright (C) 2020 Gautier Hattenberger <gautier.hattenberger@enac.fr>
*
* 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, see
* <http://www.gnu.org/licenses/>.
*)
(**
* Aircraft module for parsing XML config files
* Extract the global configuration of an aircraft
*)
module Af = Airframe
module AfT = Airframe.Target
module AfF = Airframe.Firmware
let (//) = Filename.concat
let get_string_opt = fun x -> match x with Some s -> s | None -> ""
(* type of loading (user, auto) *)
type load_type = UserLoad | AutoLoad | Unloaded
(* configuration sorted by target *)
type target_conf = {
configures: Module.configure list; (* configure variables *)
configures_default: Module.configure list; (* default configure options *)
defines: Module.define list; (* define flags *)
firmware_name: string;
board_type: string;
modules: (load_type * Module.t) list; (* list of modules *)
autopilot: bool; (* autopilot if any *)
}
(* init target conf structure *)
let init_target_conf = fun firmware_name board_type ->
{ configures = []; configures_default = []; defines = [];
firmware_name; board_type; modules = []; autopilot = false }
(* global aircraft structure *)
type t = {
name: string;
config_by_target: (string, target_conf) Hashtbl.t; (* configuration sorted by target name: (string, target_conf) *)
all_modules: Module.t list; (* list of all modules *)
airframe: Airframe.t option;
autopilots: (string option * Autopilot.t) list option;
flight_plan: Flight_plan.t option;
radio: Radio.t option;
telemetry: Telemetry.t option;
settings: Settings.t list option;
xml: Xml.xml list (* config as a list of Xml node *)
}
let init_aircraft_conf = fun name ->
{ name; config_by_target = Hashtbl.create 5; all_modules = [];
airframe = None; autopilots = None; flight_plan = None;
radio = None; telemetry = None; settings = None;
xml = []
}
(* add a module if compatible with target and firmware
* and its autoloaded modules to a conf, return final conf *)
let rec target_conf_add_module = fun conf target firmware name mtype load_type ->
let m = Module.from_module_name name mtype in
(* add autoloaded modules *)
let conf = List.fold_left (fun c autoload ->
target_conf_add_module c target firmware autoload.Module.aname autoload.Module.atype AutoLoad
) conf m.Module.autoloads in
(* check compatibility with target *)
if Module.check_loading target firmware m then
(* check is the module itself is already loaded, merging options in all case *)
let add_module = if List.exists (fun (_, lm) -> m.Module.name = lm.Module.name) conf.modules
then [] else [(load_type, m)] in
(* add configures and defines to conf if needed *)
{ conf with
configures = List.fold_left (fun cm mk ->
if Module.check_mk target firmware mk then
List.fold_left (fun cmk c ->
if not (c.Module.cvalue = None) then cmk @ [c]
else cmk
) cm mk.Module.configures
else
cm) conf.configures m.Module.makefiles;
configures_default = List.fold_left (fun cm mk ->
if Module.check_mk target firmware mk then
List.fold_left (fun cmk c ->
if not (c.Module.default = None && c.Module.case = None) then cmk @ [c]
else cmk
) cm mk.Module.configures
else
cm) conf.configures_default m.Module.makefiles;
modules = conf.modules @ add_module }
else begin
(* add "unloaded" module for reference *)
{ conf with modules = conf.modules @ [(Unloaded, m)] } end
(* sort element of an airframe type by target *)
let sort_airframe_by_target = fun config_by_target airframe ->
match airframe with
| None -> ()
| Some a ->
(* build a list of pairs (target, firmware) *)
let l = List.fold_left (fun lf f ->
List.fold_left (fun lt t ->
lt @ [(t, f)]) lf f.AfF.targets
) [] a.Af.firmwares in
(* iterate on each target *)
List.iter (fun (t, f) ->
let name = t.AfT.name in (* target name *)
if Hashtbl.mem config_by_target name then
failwith "[Error] Gen_airframe: two targets with the same name";
(* init and add configure/define from airframe *)
let conf = init_target_conf f.AfF.name t.AfT.board in
let conf = { conf with
configures = t.AfT.configures @ f.AfF.configures;
defines = t.AfT.defines @ f.AfF.defines } in
(* iter on modules in target *)
let conf = List.fold_left (fun c m_af ->
let c = { c with
configures = c.configures @ m_af.Module.configures;
defines = c.defines @ m_af.Module.defines } in
target_conf_add_module c name f.AfF.name m_af.Module.name m_af.Module.mtype UserLoad
) conf t.AfT.modules in
(* iter on modules in firmwares *)
let conf = List.fold_left (fun c m_af ->
let c = { c with
configures = c.configures @ m_af.Module.configures;
defines = c.defines @ m_af.Module.defines } in
target_conf_add_module c name f.AfF.name m_af.Module.name m_af.Module.mtype UserLoad
) conf f.AfF.modules in
(* iter on deprecated 'modules' node *)
let conf = List.fold_left (fun c m ->
List.fold_left (fun c m_af ->
let c = { c with
configures = c.configures @ m_af.Module.configures;
defines = c.defines @ m_af.Module.defines } in
target_conf_add_module c name f.AfF.name m_af.Module.name m_af.Module.mtype UserLoad
) c m.Airframe.OldModules.modules
) conf a.Airframe.modules in
Hashtbl.add config_by_target name conf
) l
(** Extract a configuration element from aircraft config,
* returns a tuple with absolute file path and element object
*
* [bool -> Xml.xml -> string -> (Xml.xml -> a') -> (string * a' option)]
*)
let get_config_element = fun flag ac_xml elt f ->
if not flag then None
else
try
let file = Xml.attrib ac_xml elt in
let abs_file = Env.paparazzi_conf // file in
Some (f abs_file)
with Xml.No_attribute _ -> None (* no attribute elt in conf file *)
let get_element_relative_path = fun flag ac_xml elt ->
if not flag then None
else
try
Some (Xml.attrib ac_xml elt)
with Xml.No_attribute _ -> None (* no attribute elt in conf file *)
(** Extract loaded modules from hashtbl config
*)
let get_loaded_modules = fun config_by_target target ->
try
let config = Hashtbl.find config_by_target target in
let modules = config.modules in
(List.fold_left (fun l (t, m) -> if t <> Unloaded then l @ [m] else l) [] modules)
with Not_found -> [] (* nothing for this target *)
(** Extract all modules
* if a modules is not in any target, it will not appear in the list
* returns an alphabetically sorted list
*)
let get_all_modules = fun config_by_target ->
let modules = ref [] in
Hashtbl.iter (fun _ conf ->
List.iter (fun (_, m) ->
if not (List.exists (fun n -> m.Module.name = n.Module.name) !modules) then
modules := m :: !modules (* add module to list *)
) conf.modules
) config_by_target;
List.sort (fun m1 m2 -> compare m1.Module.name m2.Module.name) !modules
let parse_aircraft = fun ?(parse_af=false) ?(parse_ap=false) ?(parse_fp=false) ?(parse_rc=false) ?(parse_tl=false) ?(parse_set=false) ?(parse_all=false) ?(verbose=false) target aircraft_xml ->
let name = Xml.attrib aircraft_xml "name" in
let conf_aircraft = [] in (* accumulate aircraft XML config *)
let config_by_target = Hashtbl.create 5 in
if verbose then
Printf.printf "Parsing airframe%!";
let airframe = get_config_element (parse_af || parse_all) aircraft_xml "airframe" Airframe.from_file in
if verbose then
Printf.printf " '%s'%!" (match airframe with None -> "None" | Some a -> a.Airframe.filename);
let conf_aircraft = conf_aircraft @ (match airframe with None -> [] | Some x -> [x.Airframe.xml]) in
if verbose then
Printf.printf ", sorting by target%!";
sort_airframe_by_target config_by_target airframe;
if verbose then
Printf.printf ", extracting and parsing autopilot...%!";
let autopilots = if parse_ap || parse_all then
begin
match airframe with
| None -> None
| Some af ->
(* extract autopilots *)
let autopilots = List.fold_left (fun lf f ->
let ap_f = match f.Airframe.Firmware.autopilot with None -> [] | Some a -> [a] in
let ap_t = List.fold_left (fun lt t ->
if t.Airframe.Target.name = target then
match t.Airframe.Target.autopilot with None -> lt | Some a -> a :: lt
else lt
) ap_f f.Airframe.Firmware.targets in
ap_t @ lf
) af.Airframe.autopilots af.Airframe.firmwares in
if List.length autopilots = 0 then None
else
let autopilots = List.map (fun af_ap ->
let filename = af_ap.Airframe.Autopilot.name in
let filename = if Filename.check_suffix filename ".xml"
then filename
else filename^".xml" in
let filename = Env.paparazzi_conf // "autopilot" // filename in
let ap = Autopilot.from_file filename in
(* extract modules from autopilot *)
Hashtbl.iter (fun target conf ->
let conf = List.fold_left (fun c m ->
let c = { c with
configures = c.configures @ m.Module.configures;
defines = c.defines @ m.Module.defines } in
target_conf_add_module c target "" m.Module.name m.Module.mtype UserLoad
) conf ap.Autopilot.modules in
Hashtbl.replace config_by_target target conf
) config_by_target;
(af_ap.Airframe.Autopilot.freq, ap)
) autopilots in
let c = Hashtbl.find config_by_target target in
Hashtbl.replace config_by_target target { c with autopilot = true };
Some autopilots
end
else None in
let conf_aircraft = conf_aircraft @ (match autopilots with None -> [] | Some lx -> List.map (fun (_, x) -> x.Autopilot.xml) lx) in
if verbose then
Printf.printf " done.\n%!";
if verbose then
Printf.printf "Parsing flight plan%!";
let flight_plan = get_config_element (parse_fp || parse_all) aircraft_xml "flight_plan" Flight_plan.from_file in
if verbose then begin
Printf.printf " '%s'%!" (match flight_plan with None -> "None" | Some fp -> fp.Flight_plan.filename);
Printf.printf ", extracting modules...%!"
end;
begin match flight_plan with
| None -> ()
| Some fp ->
Hashtbl.iter (fun target conf ->
let conf = List.fold_left (fun c m ->
let c = { c with
configures = c.configures @ m.Module.configures;
defines = c.defines @ m.Module.defines } in
target_conf_add_module c target "" m.Module.name m.Module.mtype UserLoad
) conf fp.Flight_plan.modules in
Hashtbl.replace config_by_target target conf
) config_by_target
end;
let conf_aircraft = conf_aircraft @ (match flight_plan with None -> [] | Some x -> [x.Flight_plan.xml]) in
if verbose then
Printf.printf " done\n%!";
if verbose then
Printf.printf "Parsing radio%!";
let radio = get_config_element (parse_rc || parse_all) aircraft_xml "radio" Radio.from_file in
if verbose then
Printf.printf " '%s'...%!" (match radio with None -> "None" | Some rc -> rc.Radio.filename);
let conf_aircraft = conf_aircraft @ (match radio with None -> [] | Some x -> [x.Radio.xml]) in
if verbose then
Printf.printf " done\n%!";
if verbose then
Printf.printf "Parsing telemetry%!";
let telemetry = get_config_element (parse_tl || parse_all) aircraft_xml "telemetry" Telemetry.from_file in
if verbose then
Printf.printf " '%s'...%!" (match telemetry with None -> "None" | Some tl -> tl.Telemetry.filename);
let conf_aircraft = conf_aircraft @ (match telemetry with None -> [] | Some x -> [x.Telemetry.xml]) in
if verbose then
Printf.printf " done\n%!";
(* TODO resolve modules dep *)
let loaded_modules = get_loaded_modules config_by_target target in
let all_modules = get_all_modules config_by_target in
if verbose then
Printf.printf "Parsing settings...%!";
let settings =
if parse_set || parse_all then begin
(* normal settings *)
let settings = try Env.filter_settings (ExtXml.attrib aircraft_xml "settings") with _ -> "" in
let settings_files = Str.split (Str.regexp " ") settings in
let settings = List.map
(fun f -> Settings.from_file (Env.paparazzi_conf // f)) settings_files in
(* modules settings *)
let settings_modules =
try Env.filter_settings (ExtXml.attrib aircraft_xml "settings_modules")
with _ -> "" in
let settings_modules_files = Str.split (Str.regexp " ") settings_modules in
let settings_modules = List.fold_left
(fun acc m ->
if List.exists (fun name ->
m.Module.xml_filename = (if Filename.is_relative name
then (Env.paparazzi_conf // name) else name)) settings_modules_files
then acc @ m.Module.settings else acc
) [] loaded_modules in
(* system settings *)
let sys_tl_settings = Telemetry.get_sys_telemetry_settings telemetry in
let sys_mod_settings = Module.get_sys_modules_settings loaded_modules in
let sys_fp_settings = Flight_plan.get_sys_fp_settings flight_plan in
let sys_ap_settings = Autopilot.get_sys_ap_settings autopilots in
(* filter system settings *)
let system_settings = List.fold_left
(fun l s -> match s with None -> l | Some x -> x::l) []
[sys_tl_settings; sys_fp_settings; sys_mod_settings; sys_ap_settings]
in
(* group into a common System dl_settings *)
let sys_dl_settings = List.fold_left (fun l s -> s.Settings.dl_settings @ l) [] system_settings in
let sys_dl_settings = {
Settings.Dl_settings.name = Some "System";
dl_settings = sys_dl_settings; dl_setting = []; headers = [];
xml = Xml.Element ("dl_settings", [("name","System")], (List.map (fun s -> s.Settings.Dl_settings.xml) sys_dl_settings))
} in
let system_settings = {
Settings.filename = ""; name = None; target = None;
dl_settings = [sys_dl_settings];
xml = Xml.Element ("settings", [], [Xml.Element ("dl_settings", [], (List.map (fun s -> s.Settings.Dl_settings.xml) [sys_dl_settings]))])
} in
(* join all settings in correct order *)
let settings = [system_settings] @ settings @ settings_modules in
(* filter on targets *)
let settings = List.fold_left (fun l s ->
if Gen_common.test_targets target (Gen_common.targets_of_string s.Settings.target) then s :: l
else l
) [] settings in
Some (List.rev settings)
end
else None
in
let conf_aircraft = conf_aircraft @ (match settings with None -> [] | Some x -> [Settings.get_settings_xml x]) in
if verbose then
Printf.printf " done\n%!";
if verbose then begin
Printf.printf "Loading modules:\n";
List.iter (fun m ->
Printf.printf " - %s (%s) [%s]\n" m.Module.name (get_string_opt m.Module.dir) m.Module.xml_filename) loaded_modules
end;
(* return aircraft conf *)
{ name; config_by_target; all_modules;
airframe; autopilots; flight_plan; radio; telemetry; settings;
xml = conf_aircraft }
sw/lib/ocaml/airframe.ml
+160
View File
@@ -0,0 +1,160 @@
(*
* Copyright (C) 2017 Gautier Hattenberger <gautier.hattenberger@enac.fr>
* Cyril Allignol <cyril.allignol@enac.fr>
*
* 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, see
* <http://www.gnu.org/licenses/>.
*)
(**
* Airframe module for parsing XML config files
*)
module OT = Ocaml_tools
module Autopilot = struct
type t = { name: string; freq: string option; xml: Xml.xml }
let from_xml = function
| Xml.Element ("autopilot", attrs, []) as xml ->
{ name = Xml.attrib xml "name";
freq = ExtXml.attrib_opt xml "freq";
xml }
| _ -> failwith "Airframe.Autopilot.from_xml: unreachable"
end
module Include = struct
type t = { href: string; xml: Xml.xml }
let from_xml = function
| Xml.Element ("include", _, []) as xml ->
{ href = Xml.attrib xml "href"; xml }
| _ -> failwith "Airframe.Include.from_xml: unreachable"
end
module Target = struct
type t = { name: string;
board: string;
modules: Module.config list;
autopilot: Autopilot.t option;
configures: Module.configure list;
defines: Module.define list;
xml: Xml.xml }
let from_xml = function
| Xml.Element ("target", _, children) as xml ->
{ name = Xml.attrib xml "name";
board = Xml.attrib xml "board";
modules = ExtXml.parse_children "module" Module.config_from_xml children;
autopilot = begin
try Some (Autopilot.from_xml (ExtXml.child xml "autopilot"))
with _ -> None end;
configures = ExtXml.parse_children "configure" Module.parse_configure children;
defines = ExtXml.parse_children "define" Module.parse_define children;
xml }
| _ -> failwith "Airframe.Autopilot.from_xml: unreachable"
end
module Firmware = struct
type t = { name: string;
targets: Target.t list;
modules: Module.config list;
autopilot: Autopilot.t option;
configures: Module.configure list;
defines: Module.define list;
xml: Xml.xml }
let from_xml = function
| Xml.Element ("firmware", _, children) as xml ->
{ name = Xml.attrib xml "name";
targets = ExtXml.parse_children "target" Target.from_xml children;
modules = ExtXml.parse_children "module" Module.config_from_xml children;
autopilot = begin
try Some (Autopilot.from_xml (ExtXml.child xml "autopilot"))
with _ -> None end;
configures = ExtXml.parse_children "configure" Module.parse_configure children;
defines = ExtXml.parse_children "define" Module.parse_define children;
xml }
| _ -> failwith "Airframe.Firmware.from_xml: unreachable"
end
module OldModules = struct
type t = { modules: Module.config list;
xml: Xml.xml }
let from_xml = function
| Xml.Element ("modules", _, children) as xml ->
{ modules = ExtXml.parse_children "module" Module.config_from_xml children;
xml }
| _ -> failwith "Airframe.Modules.from_xml: unreachable"
end
type t = {
filename: string;
name: string;
includes: Include.t list;
modules: OldModules.t list; (* NOTE this is a deprecated format, should be removed *)
firmwares: Firmware.t list;
autopilots: Autopilot.t list;
xml: Xml.xml
}
let from_xml = function
| Xml.Element ("airframe", _, children) as xml ->
if List.exists (fun c -> Xml.tag c = "modules") children then
Printf.eprintf "\nWarning: 'modules' node is deprecated, please move modules to 'firmware' section\n%!";
{ filename = ""; name = Xml.attrib xml "name";
includes = ExtXml.parse_children "include" Include.from_xml children;
modules = ExtXml.parse_children "modules" OldModules.from_xml children;
firmwares = ExtXml.parse_children "firmware" Firmware.from_xml children;
autopilots = ExtXml.parse_children "autopilot" Autopilot.from_xml children;
xml }
| _ -> failwith "Airframe.from_xml: unreachable"
let from_file = fun filename ->
let af = from_xml (Xml.parse_file filename) in
{ af with filename }
(** [expand_includes ac_id xml]
* Get expanded xml airframe if it contains 'include' nodes
*)
let expand_includes = fun ac_id xml ->
match xml with
| Xml.PCData d -> Xml.PCData d
| Xml.Element (tag, attrs, children) ->
Xml.Element (tag, attrs,
List.fold_left (fun x c ->
if Xml.tag c = "include" then begin
let filename = Str.global_replace (Str.regexp "\\$AC_ID") ac_id (ExtXml.attrib c "href") in
let filename =
if Filename.is_relative filename then Filename.concat Env.paparazzi_home filename
else filename in
let subxml = ExtXml.parse_file filename in
x @ (Xml.children subxml)
end
else x @ [c]
) [] children)
sw/lib/ocaml/autopilot.ml
+109
View File
@@ -0,0 +1,109 @@
(*
* Copyright (C) 2017 Gautier Hattenberger <gautier.hattenberger@enac.fr>
* Cyril Allignol <cyril.allignol@enac.fr>
*
* 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, see
* <http://www.gnu.org/licenses/>.
*)
(**
* Autopilot module for parsing XML config files
*)
module OT = Ocaml_tools
type t = {
filename: string;
modules: Module.config list;
xml: Xml.xml;
}
let from_xml = function
| Xml.Element ("autopilot", _, children) as xml ->
let modules = List.fold_left (fun m el ->
if Xml.tag el = "modules" then
m @ List.map Module.config_from_xml (Xml.children el)
else
m
) [] children in
{ filename = ""; modules; xml }
| _ -> failwith "Autopilot.from_xml: unreachable"
let from_file = fun filename ->
let ap = from_xml (Xml.parse_file filename) in
{ ap with filename }
(* return a Settings object from flight plan *)
let get_sys_ap_settings = fun autopilots ->
match autopilots with
| None -> None
| Some autopilots ->
let dl_settings = List.fold_left (fun sl (_, autopilot) ->
(* Filter state machines that need to be displayed *)
let sm_filtered = List.filter (fun sm ->
try (Compat.lowercase_ascii (Xml.attrib sm "settings_mode")) = "true" with _ -> false
) (Xml.children autopilot.xml) in
if List.length sm_filtered = 0 then sl
else
(* Create node if there is at least one to display *)
let dl_set = List.fold_left (fun l sm ->
let modes = List.filter (fun m -> (Xml.tag m) = "mode") (Xml.children sm) in
let name = Xml.attrib sm "name" in
(* Iter on modes and store min, max and values *)
let (_, min, max, values) = List.fold_left (fun (current, min, max, values) m ->
let print = try Compat.lowercase_ascii (Xml.attrib m "settings") <> "hide" with _ -> true in
let name = Xml.attrib m "name" in
if print then begin
let min = match min with
| None -> Some current
| Some x -> Some x
in
let max = Some current in
let values = values @ [name] in
(current + 1, min, max, values)
end
else begin
let n = match min with None -> [] | _ -> [name] in
(current + 1, min, max, values @ n)
end
) (0, None, None, []) modes in
(* check handler *)
let handler = try
let sh = Xml.attrib sm "settings_handler" in
let s = Str.split (Str.regexp "|") sh in
match s with
| [header; handler] -> [("header",header); ("handler",handler)]
| _ -> failwith "Gen_autopilot: invalid handler format"
with _ -> [("header","autopilot_core_"^name)] in
begin match min, max with
| Some min_idx, Some max_idx ->
Xml.Element ("dl_setting", [
("min", string_of_int min_idx);
("max", string_of_int max_idx);
("step", "1");
("var", "autopilot_mode_"^name);
("shortname", name);
("values", (String.concat "|" values))]
@ handler, []) :: l
| _, _ -> l
end
) [] sm_filtered in
dl_set @ sl
) [] autopilots in
let xml = Xml.Element ("dl_settings", [("name","Autopilot")], dl_settings) in
Some (Settings.from_xml (Xml.Element("settings",[],[xml])))
sw/lib/ocaml/egm96.ml
+2 -2
View File
@@ -29,12 +29,12 @@ let (//) = Filename.concat
let ncols = 1440
let nrows = 721
let n = ncols * nrows * 2
let buf = Bytes.create n
let data =
lazy (
let path = [Env.paparazzi_home // "data" // "srtm"] in
let f = Ocaml_tools.open_compress (Ocaml_tools.find_file path "WW15MGH.DAC") in
let n = ncols * nrows * 2 in
let buf = Bytes.create n in
really_input f buf 0 n;
buf)
sw/lib/ocaml/env.ml
+43 -85
View File
@@ -41,11 +41,51 @@ let paparazzi_home =
with
_ -> Filename.concat (Sys.getenv "HOME") "paparazzi"
let paparazzi_conf = paparazzi_home // "conf"
let flight_plans_path = paparazzi_home // "conf" // "flight_plans"
let flight_plans_path = paparazzi_conf // "flight_plans"
let flight_plan_dtd = flight_plans_path // "flight_plan.dtd"
(** Returns the list of directories where to look for modules
* Default PAPARAZZI_HOME/conf/modules is always returned
* Extra directories can be added with PAPARAZZI_MODULES_PATH
* where where items are ':' separated and modules are in subfolders
* of a 'modules' folder
* ex:
* PAPARAZZI_MODULES_PATH=/home/me/pprz_modules
* - pprz_modules/modules
* -- module1
* --- module1.xml
* --- module1.c
* --- module1.h
* -- module2
* --- module2.xml
* --- module2.c
* --- module2.h
*)
let modules_paths =
let default_path = paparazzi_conf // "modules" in
try
let path = Sys.getenv "PAPARAZZI_MODULES_PATH" in
let dirs = Str.split (Str.regexp ":") path in
let paths = List.fold_left (fun dl dir ->
let sub_dirs = List.fold_left (fun sdl sdir ->
let d = dir // "modules" // sdir in
if Sys.is_directory d then d :: sdl else sdl
) [] (Array.to_list (Sys.readdir (dir // "modules"))) in
dl @ sub_dirs) [] dirs
in
paths @ [default_path]
with
| Sys_error _ | Not_found -> [default_path]
(** Returns the list of directories in PAPARAZZI_MODULES_PATH *)
let modules_ext_paths =
try
let path = Sys.getenv "PAPARAZZI_MODULES_PATH" in
Str.split (Str.regexp ":") path
with _ -> []
let icon_file = paparazzi_home // "data/pictures/penguin_icon.png"
let icon_gcs_file = paparazzi_home // "data/pictures/penguin_icon_gcs.png"
let icon_mes_file = paparazzi_home // "data/pictures/penguin_icon_msg.png"
@@ -70,7 +110,7 @@ let get_gcs_icon_path = fun theme icon ->
(* or raise not found *)
raise Not_found
let dump_fp = paparazzi_src // "sw" // "tools" // "generators" // "gen_flight_plan.out -dump"
let dump_fp = paparazzi_src // "sw" // "tools" // "generators" // "dump_flight_plan.out"
let default_module_targets = "ap|sim|nps|hitl"
@@ -84,88 +124,6 @@ let filter_settings = fun settings ->
let sl = List.filter (fun s -> not (s.[0] = '[' && s.[String.length s - 1] = ']')) sl in
String.concat " " sl
(* filter on modules based on target *)
let filter_modules_target = fun module_file ->
(* get TARGET env *)
let target = try Sys.getenv "TARGET" with _ -> "" in
(* look for a specific name after settings file (in case of modules) *)
let split = Str.split (Str.regexp "~") module_file in
let xml_file, name = match split with
| [f; n] -> f, n
| _ -> module_file, ""
in
let module_xml = ExtXml.parse_file xml_file in
if Xml.tag module_xml = "module"
then
begin
(* test if the module is loaded or not
* and if a specific sub-settings is selected *)
if List.exists (fun n ->
let local_target = ExtXml.attrib_or_default n "target" default_module_targets
and tag = Xml.tag n in
if tag = "makefile" then
Str.string_match (Str.regexp (".*"^target^".*")) local_target 0
else false
) (Xml.children module_xml)
then Xml.Element ("settings", [],
List.filter (fun t ->
Xml.tag t = "settings" && ExtXml.attrib_or_default t "name" "" = name)
(Xml.children module_xml))
else Xml.Element ("settings",[],[])
end
else module_xml
let expand_ac_xml = fun ?(raise_exception = true) ac_conf ->
let prefix = fun s -> sprintf "%s/conf/%s" paparazzi_home s in
let parse_file = fun ?(parse_filter=(fun x -> ExtXml.parse_file x)) a file ->
try
parse_filter file
with
Failure msg ->
if raise_exception then
failwith msg
else begin
prerr_endline msg;
make_element "parse error" ["file",a; "msg", msg] []
end in
let parse = fun ?(pre_filter=(fun x -> x)) ?(parse_filter=(fun x -> ExtXml.parse_file x)) a ->
List.map
(fun filename -> parse_file ~parse_filter a (prefix filename))
(Str.split space_regexp (pre_filter (ExtXml.attrib ac_conf a))) in
let parse_opt = fun ?(pre_filter=(fun x -> x)) ?(parse_filter=(fun x -> ExtXml.parse_file x)) a ->
try parse ~pre_filter ~parse_filter a with ExtXml.Error _ -> [] in
(* dump expanded version of flight plan before parsing *)
let parse_fp = fun a ->
try
(* get full path file name *)
let fp = prefix (ExtXml.attrib ac_conf a) in
if Sys.is_directory fp then raise Not_found;
(* create a temporary dump file *)
let dump = Filename.temp_file "fp_dump" ".xml" in
(* set command then call it *)
let c = sprintf "%s %s > %s" dump_fp fp dump in
if Sys.command c <> 0 then
begin
Sys.remove dump;
failwith c
end;
(* parse temp fp file and then remove it *)
let fp_xml = parse_file a dump in
Sys.remove dump;
(* return Xml list *)
[fp_xml]
with _ -> []
in
let pervasives = parse "airframe" @ parse "telemetry" @ parse ~pre_filter:filter_settings "settings" in
let optionals = parse_opt "radio" @ parse_fp "flight_plan" @ parse_opt ~pre_filter:filter_settings ~parse_filter:filter_modules_target "settings_modules" @ pervasives in
let children = Xml.children ac_conf@optionals in
make_element (Xml.tag ac_conf) (Xml.attribs ac_conf) children
(* Run a command and return its results as a string. *)
let read_process command =
sw/lib/ocaml/env.mli
+5 -5
View File
@@ -28,9 +28,14 @@ val paparazzi_home : string
val paparazzi_src : string
(** Installation's files directory *)
val paparazzi_conf : string
val flight_plans_path : string
val flight_plan_dtd : string
val modules_paths : string list
val modules_ext_paths : string list
val icon_file : string
(** PNG paparazzi logo icon (48 x 48, 8-bit/color RGBA, non-interlaced) *)
@@ -74,11 +79,6 @@ val filter_settings : string -> string
* and keep the ones without brackets
* (return a string of filtered name separate by white spaces) *)
val expand_ac_xml : ?raise_exception:bool -> Xml.xml -> Xml.xml
(** Expands a conf.xml aircraft entry, adding the XML configuration files
(listed as attributes) as children. Returns an element containing the error
message if raise_exception is false (default to true) *)
val get_paparazzi_version : unit -> string
(** read the current paparazzi_version *)
sw/lib/ocaml/extXml.ml
+20 -6
View File
@@ -71,10 +71,17 @@ let attrib = fun xml attr ->
attr sprint_fields (Xml.attribs xml) in
raise (Error msg)
let attrib_option = fun xml attr ->
let attrib_opt = fun xml attr ->
try Some (Xml.attrib xml attr)
with Xml.No_attribute _ -> None
let attrib_opt_map = fun xml attr f ->
try Some (f (Xml.attrib xml attr))
with Xml.No_attribute _ -> None
let attrib_opt_int = fun xml attr -> attrib_opt_map xml attr int_of_string
let attrib_opt_float = fun xml attr -> attrib_opt_map xml attr float_of_string
let tag_is = fun x v -> Compat.lowercase_ascii (Xml.tag x) = Compat.lowercase_ascii v
let attrib_or_default = fun x a default ->
@@ -145,16 +152,14 @@ let my_to_string_fmt = fun tab_attribs x ->
Buffer.reset tmp;
s
let to_string_fmt = fun ?(tab_attribs = false) xml ->
let l = Compat.lowercase_ascii in
let rec lower = function
| Xml.PCData _ as x -> x
| Xml.Element (t, ats, cs) ->
Xml.Element(l t,
List.map (fun (a,v) -> (l a, v)) ats,
List.map lower cs) in
Xml.Element(l t,
List.map (fun (a, v) -> (l a, v)) ats,
List.map lower cs) in
my_to_string_fmt tab_attribs (lower xml)
@@ -204,6 +209,15 @@ let remove_child = fun ?(select= fun _ -> true) t xml ->
List.fold_right (fun xml rest -> if tag_is xml t && select xml then rest else xml::rest) children [])
| Xml.PCData _ -> xml
let parse_children = fun tag f children ->
List.fold_left (fun l x -> if Xml.tag x = tag then f x :: l else l)
[] children
let parse_children_attribs = fun tag f children ->
List.fold_left
(fun l x -> if Xml.tag x = tag then f (Xml.attribs x) :: l else l)
[] children
let float_attrib = fun xml a ->
let v = attrib xml a in
sw/lib/ocaml/extXml.mli
+14 -1
View File
@@ -35,6 +35,9 @@ separator is [.]). May raise [Not_found]. *)
val get_attrib : Xml.xml -> string -> string -> string
(** [get_attrib xml path attrib_name] *)
val sprint_fields : unit -> (string * string) list -> string
(** [sprint_fields attribs] pretty print attribs *)
val attrib : Xml.xml -> string -> string
val int_attrib : Xml.xml -> string -> int
val float_attrib : Xml.xml -> string -> float
@@ -43,7 +46,10 @@ val float_attrib : Xml.xml -> string -> float
val tag_is : Xml.xml -> string -> bool
(** [tag_is xml s] Case safe test *)
val attrib_option : Xml.xml -> string -> string option
val attrib_opt : Xml.xml -> string -> string option
val attrib_opt_map : Xml.xml -> string -> (string -> 'a) -> 'a option
val attrib_opt_int : Xml.xml -> string -> int option
val attrib_opt_float : Xml.xml -> string -> float option
val attrib_or_default : Xml.xml -> string -> string -> string
(** [get xml attribute_name default_value] *)
@@ -67,6 +73,13 @@ val remove_child :
?select:(Xml.xml -> bool) -> string -> Xml.xml -> Xml.xml
(** [delete_child ?select child_tag xml] Returns [xml] if not found *)
val parse_children : string -> (Xml.xml -> 'a) -> Xml.xml list -> 'a list
(** [parse_children tag f children] *)
val parse_children_attribs :
string -> ((string * string) list -> 'a) -> Xml.xml list -> 'a list
(** [parse_children_attribs tag f children] *)
val iter_tag : string -> (Xml.xml -> unit) -> Xml.xml -> unit
(** [iter_tag f tag xml] applies function [f] to every child of [xml] with
tag [tag] *)
sw/lib/ocaml/flight_plan.ml
+91
View File
@@ -0,0 +1,91 @@
(*
* Copyright (C) 2017 Gautier Hattenberger <gautier.hattenberger@enac.fr>
* Cyril Allignol <cyril.allignol@enac.fr>
*
* 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, see
* <http://www.gnu.org/licenses/>.
*)
(**
* Flight_plan module for parsing XML config files
*)
module OT = Ocaml_tools
type t = {
filename: string;
settings: Settings.Dl_setting.t list;
modules: Module.config list;
xml: Xml.xml;
}
let from_xml = function
| Xml.Element ("flight_plan", _, children) as xml ->
let settings = List.fold_left (fun s el ->
if Xml.tag el = "variables" then
s @ List.fold_left (fun s e ->
if Xml.tag e = "variable" then
let test = fun attrib ->
match ExtXml.attrib_opt e attrib with
| Some _ -> true | None -> false in
let get_opt = fun attrib -> ExtXml.attrib_opt e attrib in
if test "min" && test "max" && test "step" then
[{ Settings.Dl_setting.var = Xml.attrib e "var";
shortname = get_opt "shortname";
handler = None;
header = None;
xml = Xml.Element ("dl_setting", Xml.attribs e, []);
}] @ s
else s
else s
) [] (Xml.children el)
else
s
) [] children in
let modules = List.fold_left (fun m el ->
if Xml.tag el = "modules" then
m @ List.map Module.config_from_xml (Xml.children el)
else m
) [] children in
{ filename = ""; settings; modules; xml }
| _ -> failwith "Flight_plan.from_xml: unreachable"
let from_file = fun filename ->
let fp = from_xml (Xml.parse_file filename) in
{ fp with filename }
(* return a Settings object from flight plan *)
let get_sys_fp_settings = fun flight_plan ->
match flight_plan with
| None -> None
| Some fp ->
let dl_settings = fp.settings in
if List.length dl_settings = 0 then None
else
let dl_settings_xml = Xml.Element ("dl_settings", [ ("name", "Flight Plan") ],
List.map (fun x -> x.Settings.Dl_setting.xml) dl_settings)
in
let dl_settings =
{ Settings.Dl_settings.name = Some "Flight Plan";
dl_settings = []; dl_setting = dl_settings;
headers = ["generated/flight_plan"]; xml = dl_settings_xml }
in
let dl_settings_xml = Xml.Element ("dl_settings", [], [dl_settings_xml]) in
let xml = Xml.Element ("settings", [], [dl_settings_xml]) in
Some { Settings.filename = ""; name = None; target = None; dl_settings = [dl_settings]; xml }
sw/lib/ocaml/gen_common.ml
+34 -350
View File
@@ -24,10 +24,9 @@
open Printf
exception Firmware_Found of Xml.xml
(** simple boolean expressions *)
type bool_expr =
| Any
| Var of string
| Not of bool_expr
| And of bool_expr * bool_expr
@@ -35,6 +34,7 @@ type bool_expr =
(** evaluate a boolean expression for a given value *)
let rec eval_bool v = function
| Any -> true
| Var x -> v = x
| Not e -> not (eval_bool v e)
| And (e1, e2) -> eval_bool v e1 && eval_bool v e2
@@ -43,6 +43,7 @@ let rec eval_bool v = function
(** pretty print boolean expression *)
let print_bool = fun v e ->
let rec print_b v = function
| Any -> eprintf "Any "
| Var x -> eprintf "Var ( %s =? %s ) " x v
| Not e -> eprintf "Not ( "; (print_b v e); eprintf ") "
| And (e1, e2) -> eprintf "And ( "; print_b v e1; print_b v e2; eprintf ") "
@@ -50,22 +51,25 @@ let print_bool = fun v e ->
in
print_b v e; eprintf "\n"
(** pretty print boolean expression *)
let sprint_bool = fun v e ->
let rec print_b s v = function
| Any -> sprintf "%sAny " s
| Var x -> sprintf "%sVar ( %s =? %s ) " s x v
| Not e -> let s = sprintf "%sNot ( " s in
let s = print_b s v e in
sprintf "%s) " s
| And (e1, e2) -> let s = sprintf "%sAnd ( " s in
let s = print_b s v e1 in
let s = print_b s v e2 in
sprintf "%s) " s
| Or (e1, e2) -> let s = sprintf "%sOr ( " s in
let s = print_b s v e1 in
let s = print_b s v e2 in
sprintf "%s) " s
in
print_b "" v e
type module_conf = {
name: string;
xml: Xml.xml;
file: string;
filename: string;
vpath: string option;(* this field should be removed after transition phase *)
param: Xml.xml list;
targets: bool_expr
}
let (//) = Filename.concat
let paparazzi_conf = Env.paparazzi_home // "conf"
let modules_dir = paparazzi_conf // "modules"
let autopilot_dir = paparazzi_conf // "autopilot"
(** remove all duplicated elements of a list *)
let singletonize = fun ?(compare = compare) l ->
@@ -81,141 +85,25 @@ let union = fun l1 l2 -> singletonize (l1 @ l2)
(** union of a list of list *)
let union_of_lists = fun l -> singletonize (List.flatten l)
(** [targets_of_field]
* Returns the targets expression of a makefile node in modules
* Default "ap|sim" *)
let targets_of_field =
(** [targets_of_string]
* Returns the targets expression of a string
*)
let targets_of_string =
let rec expr_of_targets op = function
| [] -> Var ""
| [] -> Any
| [e] -> Var e
| l::ls -> op (Var l) (expr_of_targets op ls)
in
let pipe = Str.regexp "|" in
fun field default ->
let f = ExtXml.attrib_or_default field "target" default in
if String.length f > 0 && String.get f 0 = '!' then
Not (expr_of_targets (fun x y -> Or(x,y)) (Str.split pipe (String.sub f 1 ((String.length f) - 1))))
else
expr_of_targets (fun x y -> Or(x,y)) (Str.split pipe f)
fun targets ->
match targets with
| None -> Any
| Some t ->
if String.length t > 0 && String.get t 0 = '!' then
Not (expr_of_targets (fun x y -> Or(x,y)) (Str.split pipe (String.sub t 1 ((String.length t) - 1))))
else
expr_of_targets (fun x y -> Or(x,y)) (Str.split pipe t)
(** [get_autopilot_of_airframe xml]
* Returns (autopilot xml, main freq) from airframe xml file *)
let get_autopilot_of_airframe = fun ?target xml ->
(* first, find firmware related to the target *)
let firmware =
match target with
| None -> None
| Some t -> begin try
Xml.iter (fun x ->
if Xml.tag x = "firmware" then begin
Xml.iter (fun xt ->
if Xml.tag xt = "target" then begin
if Xml.attrib xt "name" = t then raise (Firmware_Found x)
end) x
end) xml;
None
with Firmware_Found f -> Some f | _ -> None
end
in
(* extract all autopilot node from xml tree for correct target *)
let rec iter = fun targets ap xml ->
match xml with
| Xml.PCData _ -> ap
| Xml.Element (tag, _attrs, children) when tag = "autopilot" ->
[Xml.Element (tag, _attrs, children)] @ ap (* found an autopilot *)
| Xml.Element (tag, _attrs, children) when tag = "firmware" ->
begin match firmware with
| Some f when String.compare (Xml.to_string f) (Xml.to_string xml) = 0 ->
List.fold_left (fun acc xml ->
iter targets acc xml) ap children
| None ->
List.fold_left (fun acc xml ->
iter targets acc xml) ap children
| _ -> ap end (* skip wrong firmware *)
| Xml.Element (tag, _attrs, children) when tag = "target" ->
let target_name = Xml.attrib xml "name" in
begin match target with
| None ->
List.fold_left
(fun acc xml -> iter targets acc xml) ap children
| Some t when t = target_name ->
List.fold_left
(fun acc xml -> iter targets acc xml) ap children
| _ -> ap end (* skip wrong target *)
| Xml.Element (tag, _attrs, children) ->
List.fold_left
(fun acc xml -> iter targets acc xml) ap children
in
let ap = iter target [] xml in
(* Raise error if more than one modules section *)
match ap with
[autopilot] ->
let freq = try Some (Xml.attrib autopilot "freq") with _ -> None 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 per firmware/target in your airframe file"
(** [get_targets_of_module xml]
* Returns the boolean expression of targets of a module *)
let get_targets_of_module = fun xml ->
Xml.fold (fun a x ->
match Compat.lowercase_ascii (Xml.tag x) with
| "makefile" when a = Var "" -> targets_of_field x Env.default_module_targets
| "makefile" -> Or (a, targets_of_field x Env.default_module_targets)
| _ -> a
) (Var "") xml
let module_name = fun xml ->
let name = ExtXml.attrib xml "name" in
try if Filename.check_suffix name ".xml" then Filename.chop_extension name else name with _ -> name
exception Subsystem of string
let get_module = fun m global_targets ->
match Xml.tag m with
| "module" | "autoload" ->
let name = module_name m in
let filename =
let modtype = ExtXml.attrib_or_default m "type" "" in
name ^ (if modtype = "" then "" else "_") ^ modtype ^ ".xml" in
let file = modules_dir // filename in
if not (Sys.file_exists file) then raise (Subsystem file) else
let xml = ExtXml.parse_file file in
let targets = get_targets_of_module xml in
let targets = Or (global_targets, targets) in
{ name = name; xml = xml; file = file; filename = filename; vpath = None;
param = Xml.children m; targets = targets }
| "load" -> (* this case should be removed after transition phase *)
let dir, vpath =
try
let dir = ExtXml.attrib m "dir" in
let dir =
if Filename.is_relative dir then Env.paparazzi_home // dir
else dir in
(dir, Some dir)
with _ -> modules_dir, None in
let filename = ExtXml.attrib m "name" in
let name = Filename.chop_extension filename in
let file = dir // filename in
let xml = ExtXml.parse_file file in
let targets = get_targets_of_module xml in
let extra_targets = Or (global_targets, targets_of_field m "") in
let targets = Or (extra_targets, targets) in
{ name = name; xml = xml; file = file; filename = filename; vpath = vpath;
param = Xml.children m; targets = targets }
| _ -> Xml2h.xml_error "module, autoload or load"
(** [get_autoloaded_modules module]
* Return a list of modules to be automaticaly added
* Only works with actual modules (no subsystems) *)
let rec get_autoloaded_modules = fun m ->
let m = get_module m (Var "") in
List.fold_left (fun l t ->
if ExtXml.tag_is t "autoload" then
let am = get_module t (Var "") in
(am :: ((try get_autoloaded_modules am.xml with _ -> []) @ l))
else l
) [] (Xml.children m.xml)
(** [test_targets target targets]
* Test if [target] is allowed [targets]
@@ -223,207 +111,3 @@ let rec get_autoloaded_modules = fun m ->
let test_targets = fun target targets ->
eval_bool target targets
(** [expand_includes ac_id xml]
* Expand xml airframe file if it contains 'include' nodes
*)
let expand_includes = fun ac_id xml ->
match xml with
| Xml.PCData d -> Xml.PCData d
| Xml.Element (tag, attrs, children) ->
Xml.Element (tag, attrs,
List.fold_left (fun x c ->
if Xml.tag c = "include" then begin
let filename = Str.global_replace (Str.regexp "\\$AC_ID") ac_id (ExtXml.attrib c "href") in
let filename =
if Filename.is_relative filename then Env.paparazzi_home // filename
else filename in
let subxml = ExtXml.parse_file filename in
x @ (Xml.children subxml)
end
else x @ [c]
) [] children)
(** [get_modules_of_airframe xml]
* Returns a list of module configuration from airframe file *)
let rec get_modules_of_airframe = fun ?target xml ->
let is_module = fun tag -> List.mem tag [ "module"; "load" ] in
(* first, find firmware related to the target *)
let firmware =
match target with
| None -> None
| Some t -> begin try
Xml.iter (fun x ->
if Xml.tag x = "firmware" then begin
Xml.iter (fun xt ->
if Xml.tag xt = "target" then begin
if Xml.attrib xt "name" = t then raise (Firmware_Found x)
end) x
end) xml;
None
with Firmware_Found f -> Some f | _ -> None
end
in
(* extract modules from xml tree *)
let rec iter_modules = fun ?(subsystem_fallback=true) targets modules xml ->
match xml with
| Xml.PCData _ -> modules
| Xml.Element (tag, _attrs, children) when is_module tag ->
begin try
let m = get_module xml targets in
let al = get_autoloaded_modules xml in
List.fold_left
(fun acc xml -> iter_modules targets acc xml)
(m :: (al @ modules)) children
with Subsystem file ->
if subsystem_fallback then modules
else failwith ("Unkown module " ^ file)
end
| Xml.Element (tag, _attrs, children) when tag = "firmware" ->
begin match firmware with
| Some f when String.compare (Xml.to_string f) (Xml.to_string xml) = 0 ->
List.fold_left (fun acc xml ->
iter_modules targets acc xml) modules children
| None ->
List.fold_left (fun acc xml ->
iter_modules targets acc xml) modules children
| _ -> modules end (* skip wrong firmware *)
| Xml.Element (tag, _attrs, children) when tag = "target" ->
let target_name = Xml.attrib xml "name" in
begin match target with
| None ->
List.fold_left
(fun acc xml -> iter_modules targets acc xml) modules children
| Some t when t = target_name ->
List.fold_left
(fun acc xml -> iter_modules targets acc xml) modules children
| _ -> modules end
| Xml.Element (tag, _attrs, _children) when tag = "include" ->
let filename = ExtXml.attrib xml "href" in
let subxml = ExtXml.parse_file filename in
iter_modules targets modules subxml
| Xml.Element (tag, _attrs, children) ->
let (targets, use_fallback) =
if tag = "modules" then (targets_of_field xml "", false) else (targets, true) in
List.fold_left
(fun acc xml -> iter_modules ~subsystem_fallback:use_fallback targets acc xml) modules children in
let modules = iter_modules (Var "") [] xml in
let ap_modules =
try
let ap_file = fst (get_autopilot_of_airframe ?target xml) in
iter_modules (Var "") [] (ExtXml.parse_file ap_file)
with _ -> [] in
let modules = List.rev (ap_modules @ modules) in
match target with
| None -> modules
| Some t -> List.filter (fun m -> test_targets t m.targets) modules
(** [get_modules_of_flight_plan xml]
* Returns a list of module configuration from flight plan file *)
let get_modules_of_flight_plan = fun xml ->
let rec iter_modules = fun targets modules xml ->
match xml with
| Xml.PCData _ -> modules
| Xml.Element (tag, _attrs, children) when tag = "module" ->
begin try
let m = get_module xml targets in
List.fold_left
(fun acc xml -> iter_modules targets acc xml)
(m :: modules) children
with _ -> modules end
| Xml.Element (tag, _attrs, children) ->
List.fold_left
(fun acc xml -> iter_modules targets acc xml) modules children in
List.rev (iter_modules (Var "") [] xml)
(** [singletonize_modules xml]
* Returns a list of singletonized modules were options are merged
*)
let singletonize_modules = fun ?(verbose=false) ?target xml ->
let rec loop = fun l ->
match l with
| [] | [_] -> l
| x::xs ->
let (duplicates, rest) = List.partition (fun m -> m.file = x.file) xs in
if List.length duplicates > 0 && verbose then begin
(* print info message on stderr *)
let t = match target with None -> "" | Some t -> Printf.sprintf " for target %s" t in
Printf.eprintf "Info: module '%s' has been loaded several times%s, merging options\n" x.filename t;
List.iter (fun opt ->
let name = Xml.attrib opt "name" in
List.iter (fun d ->
List.iter (fun d_opt ->
if Xml.attrib d_opt "name" = name then
Printf.eprintf "Warning: - option '%s' is defined multiple times, this may cause unwanted behavior or compilation errors\n" name
) d.param;
) duplicates;
) x.param;
end;
let m = { name = x.name; xml = x.xml; file = x.file; filename = x.filename;
vpath = x.vpath; param = List.flatten (List.map (fun m -> m.param) ([x] @ duplicates));
targets = List.fold_left (fun a x ->
match a with
| Var "" -> x.targets
| _ -> Or (a, x.targets)
) (Var "") ([x] @ duplicates) } in
m::loop rest
in
loop xml
(** [get_modules_of_config ?target flight_plan airframe]
* Returns a list of pair (modules ("load" node), targets) from airframe file and flight plan.
* The modules are singletonized and options are merged *)
let get_modules_of_config = fun ?target ?verbose ac_id af_xml fp_xml ->
let af_modules = get_modules_of_airframe ?target (expand_includes ac_id af_xml)
and fp_modules = get_modules_of_flight_plan fp_xml in
(* singletonize modules list and reverse list to have it in the correct order *)
List.rev (singletonize_modules ?verbose ?target (af_modules @ fp_modules))
(** [get_modules_name xml]
* Returns a list of loaded modules' name *)
let get_modules_name = fun ac_id xml ->
let target = try Sys.getenv "TARGET" with _ -> "" in
(* extract all modules sections for a given target *)
let modules = get_modules_of_airframe ~target (expand_includes ac_id xml) in
(* return a list of modules name *)
List.map (fun m -> ExtXml.attrib m.xml "name") modules
(** [get_modules_dir xml]
* Returns the list of modules directories *)
let get_modules_dir = fun modules ->
let dir = List.map (fun m -> try Xml.attrib m.xml "dir" with _ -> ExtXml.attrib m.xml "name") modules in
singletonize dir
(** [is_element_unselected target modules file]
* Returns True if [target] is supported in the element [file] and, if it is
* a module, that it is loaded,
* [file] being the file name of an Xml file (module or setting) *)
let is_element_unselected = fun ?(verbose=false) target modules name ->
try
let name = (Env.paparazzi_home // "conf" // name) in
let xml = ExtXml.parse_file name in
match Xml.tag xml with
| "settings" ->
let target_list = targets_of_field xml "" in
let unselected = not (test_targets target target_list) in
if unselected && not (target_list = Var ("")) && verbose then
begin Printf.printf "Info: settings '%s' unloaded for target '%s'\n" name target; flush stdout end;
unselected && not (target_list = Var (""))
| "module" ->
let unselected = List.for_all (fun m -> m.file <> name) modules in
if unselected && verbose then
begin Printf.printf "Info: module '%s' unloaded for target '%s'\n" name target; flush stdout end
else begin
if verbose then
(* display possible unloading of settings when the module itself is loaded *)
List.iter (fun n ->
let tag = Xml.tag n in
let target_list = targets_of_field n "" in
let valid = test_targets target target_list in
if tag = "settings" && not (ExtXml.attrib_or_default n "target" "" = "") && not valid then
begin Printf.printf "Info: settings of module '%s' unloaded for target '%s'\n" name target; flush stdout end;
) (Xml.children xml)
end;
unselected
| _ -> false
with _ -> false
sw/lib/ocaml/gen_common.mli
+6 -59
View File
@@ -24,79 +24,26 @@
(* simple boolean expressions *)
type bool_expr =
| Any
| Var of string
| Not of bool_expr
| And of bool_expr * bool_expr
| Or of bool_expr * bool_expr
(* Module configuration:
* Xml node
* file (with path)
* file name only
* optional vpath
* parameters
* extrat targets
*)
type module_conf = { name : string; xml : Xml.xml; file : string; filename : string; vpath : string option; param : Xml.xml list; targets : bool_expr; }
(* Modules directory *)
val modules_dir : string
val print_bool : string -> bool_expr -> unit
val sprint_bool : string -> bool_expr -> string
(** remove all duplicated elements of a list *)
val singletonize : ?compare: ('a -> 'a -> int) -> 'a list -> 'a list
(** [targets_of_field] Xml node, default
* Returns the targets expression of a makefile node in modules
* Default "ap|sim" *)
val targets_of_field : Xml.xml -> string -> bool_expr
exception Subsystem of string
val module_name : Xml.xml -> string
val get_module : Xml.xml -> bool_expr -> module_conf
(** [expand_includes ac_id xml]
* Expand xml airframe file if it contains 'include' nodes
(** [targets_of_string] targets
* Returns the targets expression of a string
*)
val expand_includes : string -> Xml.xml -> Xml.xml
(** [get_modules_of_airframe xml]
* Returns a list of pair (modules ("load" node), targets) from airframe file *)
val get_modules_of_airframe : ?target: string -> Xml.xml -> module_conf list
(** [get_modules_of_flight_plan xml]
* Returns a list of module configuration from flight plan file *)
val get_modules_of_flight_plan : Xml.xml -> module_conf list
(** [get_modules_of_config ?target ac_id flight_plan airframe]
* Returns a list of pair (modules ("load" node), targets) from airframe file and flight plan.
* The modules are singletonized and options are merged *)
val get_modules_of_config : ?target:string -> ?verbose:bool -> string -> Xml.xml -> Xml.xml -> module_conf list
val targets_of_string : string option -> bool_expr
(** [test_targets target targets]
* Test if [target] is allowed [targets]
* Return true if target is allowed, false if target is not in list or rejected (prefixed by !) *)
val test_targets : string -> bool_expr -> bool
(** [get_targets_of_module xml] Returns the boolean expression of targets of a module *)
val get_targets_of_module : Xml.xml -> bool_expr
(** [get_modules_name ac_id xml]
* Returns a list of loaded modules' name *)
val get_modules_name : string -> Xml.xml -> string list
(** [get_modules_dir xml]
* Returns the list of modules directories *)
val get_modules_dir : module_conf list -> string list
(** [get_autopilot_of_airframe ?target xml]
* Returns (autopilot file, main freq) from airframe xml file
* Raise Not_found if no autopilot
* Fail if more than one *)
val get_autopilot_of_airframe : ?target:string -> Xml.xml -> (string * string option)
(** [is_element_unselected target modules file]
* Returns True if [target] is supported in the element [file] and, if it is
* a module, that it is loaded,
* [file] being the file name of an Xml file (module or setting) *)
val is_element_unselected : ?verbose:bool -> string -> module_conf list -> string -> bool
sw/lib/ocaml/module.ml
+365
View File
@@ -0,0 +1,365 @@
(*
* Copyright (C) 2017 Gautier Hattenberger <gautier.hattenberger@enac.fr>
* Cyril Allignol <cyril.allignol@enac.fr>
*
* 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, see
* <http://www.gnu.org/licenses/>.
*)
(**
* 'Module' module for parsing XML config files
*)
module OT = Ocaml_tools
module GC = Gen_common
let find_name = fun xml ->
try
let name = Xml.attrib xml "name" in
if Filename.check_suffix name ".xml" then Filename.chop_extension name
else name
with
| Not_found ->
let msg = Printf.sprintf "Error: Attribute 'name' expected in %a"
ExtXml.sprint_fields (Xml.attribs xml) in
raise (ExtXml.Error msg)
type file = { filename: string; directory: string option; filecond: string option }
type file_arch = file
let parse_file = fun xml ->
match xml with
| Xml.Element ("file", _, []) | Xml.Element ("file_arch", _, []) ->
{ filename = find_name xml;
directory = ExtXml.attrib_opt xml "dir";
filecond = ExtXml.attrib_opt xml "cond" }
| _ -> failwith "Module.parse_file: unreachable"
type configure = {
cname: string;
cvalue: string option;
case: string option;
default: string option;
cdescription: string option
}
let parse_configure = fun xml ->
let get = fun x -> ExtXml.attrib_opt xml x in
{ cname = find_name xml; cvalue = get "value"; case = get "case";
default = get "default"; cdescription = get "description" }
type define = {
dname: string;
dvalue: string option;
integer: int option;
dunit: string option;
dtype: string option;
ddescription: string option;
cond: string option
}
let parse_define = fun xml ->
let get = fun x -> ExtXml.attrib_opt xml x in
{ dname = find_name xml; dvalue = get "value";
integer = begin match get "integer" with
| None -> None | Some i -> Some (int_of_string i) end;
dunit = get "unit"; dtype = get "type";
ddescription = get "description"; cond = get "cond" }
type incl = { element: string; condition: string option }
type flag = { flag: string; value: string; fcond: string option }
type raw = string
type makefile = {
targets: string option;
firmware: string option;
condition: string option;
configures: configure list;
defines: define list;
inclusions: incl list;
flags: flag list;
files: file list;
files_arch: file list;
raws: raw list
}
let empty_makefile =
{ targets = None; firmware = None; condition = None;
configures = []; defines = [];
inclusions = []; flags = []; files = []; files_arch = []; raws = [] }
let rec parse_makefile mkf = function
| Xml.Element ("makefile", _, children) as xml ->
let targets = ExtXml.attrib_opt xml "target"
and firmware = ExtXml.attrib_opt xml "firmware"
and condition = ExtXml.attrib_opt xml "cond" in
List.fold_left parse_makefile
{ mkf with targets; firmware; condition } children
| Xml.Element ("configure", _, []) as xml ->
{ mkf with configures = parse_configure xml :: mkf.configures }
| Xml.Element ("define", _, []) as xml ->
{ mkf with defines = parse_define xml :: mkf.defines }
| Xml.Element ("include", _, []) as xml ->
{ mkf with inclusions =
{ element = find_name xml;
condition = ExtXml.attrib_opt xml "cond" }
:: mkf.inclusions }
| Xml.Element ("flag", _, []) as xml ->
let flag = Xml.attrib xml "name" and value = Xml.attrib xml "value" in
{ mkf with flags = { flag; value; fcond = ExtXml.attrib_opt xml "cond" }
:: mkf.flags }
| Xml.Element ("file", _, []) as xml ->
{ mkf with files = parse_file xml :: mkf.files }
| Xml.Element ("file_arch", _, []) as xml ->
{ mkf with files_arch = parse_file xml :: mkf.files_arch }
| Xml.Element ("raw", [], [Xml.PCData raw]) ->
{mkf with raws = raw :: mkf.raws}
| _ -> failwith "Module.parse_makefile: unreachable"
type autorun = True | False | Lock
type period_freq = Unset | Set of float * float | Freq of string | Period of string
type periodic = {
call: string;
fname: string;
period_freq: period_freq;
delay: int option;
start: string option;
stop: string option;
autorun: autorun
}
let parse_periodic = fun xml ->
let get = fun x -> ExtXml.attrib_opt xml x in
let geti = fun x -> ExtXml.attrib_opt_int xml x in
let call = snd (List.find (fun (a, _) -> Compat.lowercase_ascii a = "fun")
(Xml.attribs xml)) in
let call_regexp = Str.regexp "\\([a-zA-Z_][a-zA-Z0-9_]*\\)\\(.*\\)" in
let fname =
if Str.string_match call_regexp call 0 then
let fname = Str.matched_group 1 call and args = Str.matched_group 2 call in
if args = "" || Str.string_match (Str.regexp "(.*)") args 0 then fname
else failwith ("Module.parse_periodic: invalid function call: " ^ call)
else failwith ("Module.parse_periodic: invalid function name: " ^ call) in
let period_freq = match get "period", get "freq" with
| None, None -> Unset
| None, Some f -> begin
try let f = float_of_string f in Set (1. /. f, f)
with _ -> Freq f
end
| Some p, None -> begin
try let p = float_of_string p in Set (p, 1. /. p)
with _ -> Period p
end
| Some p, Some _ -> begin
Printf.eprintf "Warning: both period and freq are defined ";
Printf.eprintf "but only period is used for function %s\n%!" fname;
try let p = float_of_string p in Set (p, 1. /. p)
with _ -> Period p
end
in
{ call; fname; period_freq; delay = geti "delay";
start = get "start"; stop = get "stop";
autorun = match get "autorun" with
| None -> Lock
| Some "TRUE" | Some "true" -> True
| Some "FALSE" | Some "false" -> False
| Some "LOCK" | Some "lock" -> Lock
| Some _ -> failwith "Module.parse_periodic: unreachable" }
type event = { ev: string; handlers: string list }
let make_event = fun f handlers ->
{ ev = f;
handlers = List.map
(function
| Xml.Element ("handler", _, []) as xml -> Xml.attrib xml "fun"
| _ -> failwith "Module.make_event: unreachable"
) handlers }
let fprint_event = fun ch e -> Printf.fprintf ch "%s;\n" e.ev
type datalink = { message: string; func: string }
let fprint_datalink = fun ch d ->
Printf.fprintf ch "(msg_id == DL_%s) { %s; }\n" d.message d.func
type autoload = {
aname: string;
atype: string option
}
type config = { name: string;
mtype: string option;
dir: string option;
configures: configure list;
defines: define list;
xml: Xml.xml }
let config_from_xml = function
| Xml.Element ("module", _, children) as xml ->
{ name = Xml.attrib xml "name";
mtype = ExtXml.attrib_opt xml "type";
dir = ExtXml.attrib_opt xml "dir";
configures = ExtXml.parse_children "configure" parse_configure children;
defines = ExtXml.parse_children "define" parse_define children;
xml }
| _ -> failwith "Module.config_from_xml: unreachable"
type t = {
xml_filename: string;
name: string;
dir: string option;
task: string option;
path: string;
doc: Xml.xml;
requires: string list;
conflicts: string list;
provides: string list;
autoloads: autoload list;
settings: Settings.t list;
headers: file list;
inits: string list;
periodics: periodic list;
events: event list;
datalinks: datalink list;
makefiles: makefile list;
xml: Xml.xml
}
let empty =
{ xml_filename = ""; name = ""; dir = None;
task = None; path = ""; doc = Xml.Element ("doc", [], []);
requires = []; conflicts = []; provides = []; autoloads = []; settings = [];
headers = []; inits = []; periodics = []; events = []; datalinks = [];
makefiles = []; xml = Xml.Element ("module", [], []) }
let parse_module_list = Str.split (Str.regexp "[ \t]*,[ \t]*")
let rec parse_xml m = function
| Xml.Element ("module", _, children) as xml ->
let name = find_name xml
and dir = ExtXml.attrib_opt xml "dir"
and task = ExtXml.attrib_opt xml "task" in
List.fold_left parse_xml { m with name; dir; task; xml } children
| Xml.Element ("doc", _, _) as xml -> { m with doc = xml }
(*| Xml.Element ("settings_file", [("name", name)], files) -> m (* TODO : remove unused *)*)
| Xml.Element ("settings", _, _) as xml ->
{ m with settings = Settings.from_xml xml :: m.settings }
| Xml.Element ("depends", _, [Xml.PCData depends]) ->
{ m with requires = parse_module_list depends }
| Xml.Element ("conflicts", _, [Xml.PCData conflicts]) ->
{ m with conflicts = parse_module_list conflicts }
| Xml.Element ("provides", _, [Xml.PCData provides]) ->
{ m with provides = parse_module_list provides }
| Xml.Element ("autoload", _, []) as xml ->
let aname = find_name xml
and atype = ExtXml.attrib_opt xml "type" in
{ m with autoloads = { aname; atype } :: m.autoloads }
| Xml.Element ("header", [], files) ->
{ m with headers =
List.fold_left (fun acc f -> parse_file f :: acc) m.headers files
}
| Xml.Element ("init", _, []) as xml ->
{ m with inits = Xml.attrib xml "fun" :: m.inits }
| Xml.Element ("periodic", _, []) as xml ->
{ m with periodics = parse_periodic xml :: m.periodics }
| Xml.Element ("event", _, handlers) as xml ->
let f = Xml.attrib xml "fun" in
{ m with events = make_event f handlers :: m.events }
| Xml.Element ("datalink", _, []) as xml ->
let message = Xml.attrib xml "message"
and func = Xml.attrib xml "fun" in
{ m with datalinks = { message; func } :: m.datalinks }
| Xml.Element ("makefile", _, _) as xml ->
{ m with makefiles = parse_makefile empty_makefile xml :: m.makefiles }
| _ -> failwith "Module.parse_xml: unreachable"
let from_xml = fun xml ->
let m = parse_xml empty xml in
{ m with
settings = List.rev m.settings;
headers = List.rev m.headers;
inits = List.rev m.inits;
makefiles = List.rev m.makefiles
}
let from_file = fun filename -> from_xml (Xml.parse_file filename)
(** search and parse a module xml file and return a Module.t *)
(* FIXME search folder path: <PPRZ_PATH>/*/<module_name[_type]>.xml *)
exception Module_not_found of string
let from_module_name = fun name mtype ->
(* concat module type if needed *)
let name = match mtype with Some t -> name ^ "_" ^ t | None -> name in
(* determine if name already have an extension *)
let name = if Filename.check_suffix name ".xml" then name else name ^ ".xml" in
(* determine if name is implicit
* if not, search for absolute name in search path
* may raise Module_not_found if no file found *)
let name =
if Filename.is_implicit name then
let rec find_abs = function
| [] -> raise (Module_not_found name)
| b :: bl ->
let full_name = Filename.concat b name in
if Sys.file_exists full_name then full_name else find_abs bl
in find_abs Env.modules_paths
else if Sys.file_exists name then name
else raise (Module_not_found name)
in
let m = from_xml (ExtXml.parse_file name) in
let settings = List.map (fun s -> { s with Settings.filename = name }) m.settings in
{ m with xml_filename = name; settings }
(** check if a makefile node is compatible with a target and a firmware
* TODO add 'board' type filter ? *)
let check_mk = fun target firmware mk ->
(mk.firmware = (Some firmware) || mk.firmware = None) && GC.test_targets target (GC.targets_of_string mk.targets)
(** check if a module is compatible with a target and a firmware *)
let check_loading = fun target firmware m ->
List.exists (check_mk target firmware) m.makefiles
(* TODO merge *)
let status_name = fun mod_name p -> mod_name ^ "_" ^ p.fname ^ "_status"
(* return a Settings object from modules *)
let get_sys_modules_settings = fun modules ->
(* build a XML node corresponding to the settings *)
let mod_settings = List.fold_left (fun lm m ->
let periodic_settings = List.fold_left (fun lp p ->
if not (p.autorun = Lock) then
lp @ [Xml.Element("dl_setting",
[("min","2");
("max","3");
("step","1");
("var", status_name m.name p);
("shortname", p.fname);
("values","START|STOP")],[])]
else lp
) [] m.periodics in
lm @ periodic_settings
) [] modules in
let xml = Xml.Element("dl_settings",[("name","Modules")],mod_settings) in
if List.length mod_settings > 0 then
Some (Settings.from_xml (Xml.Element("settings",[],[xml])))
else
None
sw/lib/ocaml/ocaml_tools.ml
+18
View File
@@ -32,6 +32,9 @@ let open_compress file =
Unix.open_process_in ("bunzip2 -c "^file)
else open_in file
let compress file =
assert (Sys.command ("gzip "^file) = 0)
let extensions = ["";".gz";".Z";".bz2";".zip";".ZIP"]
let find_file = fun path file ->
@@ -92,3 +95,18 @@ let shifter = fun n default ->
a.(!i) <- new_value;
i := (!i + 1) mod n;
old_value
let assoc_opt = fun k l ->
try Some (List.assoc k l) with Not_found -> None
let assoc_opt_map = fun k l f ->
try Some (f (List.assoc k l)) with Not_found -> None
let assoc_opt_int = fun k l ->
try Some (int_of_string (List.assoc k l)) with Not_found -> None
let assoc_default = fun k l def ->
try List.assoc k l with Not_found -> def

Some files were not shown because too many files have changed in this diff Show More