initial commit

3 files changed, 2140 insertions, 0 deletions

diff --git a/lib/Kratos/DFADriver.pm b/lib/Kratos/DFADriver.pm
new file mode 100644
index 0000000..a3473f7
--- /dev/null
+++ b/lib/Kratos/DFADriver.pm
@@ -0,0 +1,1334 @@
+package Kratos::DFADriver;
+
+use strict;
+use warnings;
+use 5.020;
+
+use parent 'Class::Accessor';
+
+use Archive::Tar;
+use AspectC::Repo;
+use Carp;
+use Carp::Assert::More;
+use Cwd;
+use DateTime;
+use Device::SerialPort;
+use File::Slurp qw(read_dir read_file write_file);
+use IPC::Run qw(harness);
+use JSON;
+use Kratos::DFADriver::DFA;
+use Kratos::DFADriver::Model;
+use List::Util qw(first);
+use List::MoreUtils qw(pairwise);
+use MIMOSA;
+use MIMOSA::Log;
+
+Kratos::DFADriver->mk_ro_accessors(qw(class_name dfa mimosa model repo));
+
+our $VERSION = '0.00';
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	my $self = \%opt;
+
+	$self->{dfa}           = Kratos::DFADriver::DFA->new(%opt);
+	$self->{mimosa}        = MIMOSA->new(%opt);
+	$self->{model}         = Kratos::DFADriver::Model->new(%opt);
+	$self->{repo}          = AspectC::Repo->new;
+	$self->{class_name}    = $self->{model}->class_name;
+	$self->{lp}{iteration} = 1;
+
+	bless( $self, $class );
+
+	$self->set_paths;
+	$self->dfa->set_model( $self->model );
+
+	return $self;
+}
+
+sub set_paths {
+	my ($self) = @_;
+
+	my $xml_path = $self->{xml_file};
+	$xml_path =~ s{ /?+dfa-driver/[^/]+[.]xml $ }{}x;
+
+	my $prefix = $self->{prefix} = cwd() . "/${xml_path}/src";
+	my $class_prefix
+	  = $self->repo->get_class_path_prefix( $self->{class_name} );
+	$self->{ah_file} = "${prefix}/${class_prefix}_dfa.ah";
+	$self->{cc_file} = "${prefix}/${class_prefix}_dfa.cc.inc";
+	$self->{h_file}  = "${prefix}/${class_prefix}_dfa.h.inc";
+}
+
+sub set_output {
+	my ($self, $mode) = @_;
+
+	if ($mode eq 'tex') {
+		$self->{tex} = 1;
+	}
+
+	return $self;
+}
+
+sub preprocess {
+	my ( $self, @files ) = @_;
+	my @logs;
+	my @json_files;
+
+	for my $i ( 0 .. $#files ) {
+		push(
+			@logs,
+			MIMOSA::Log->new(
+				data_file     => $files[$i],
+				fast_analysis => $self->{fast_analysis},
+				model         => $self->model,
+				merge_args    => $self->{merge_args},
+				tmpsuffix     => $i,
+			)
+		);
+	}
+
+	for my $log (@logs) {
+		if ( not $self->{cache} or not $log->load_cache ) {
+			$log->load_archive;
+			$log->preprocess;
+			$log->save_cache;
+		}
+		push( @json_files, $log->json_name );
+	}
+
+	$self->{log} = $logs[0];
+	return ( \@logs, \@json_files );
+}
+
+sub analyze {
+	my ( $self, @files )      = @_;
+	my ( $logs, $json_files ) = $self->preprocess(@files);
+	$self->log->analyze( @{$json_files} );
+}
+
+sub validate_model {
+	my ( $self, @files )      = @_;
+	my ( $logs, $json_files ) = $self->preprocess(@files);
+	$self->log->validate( @{$json_files} );
+	$self->assess_validation;
+}
+
+sub crossvalidate_model {
+	my ( $self, @files )      = @_;
+	my ( $logs, $json_files ) = $self->preprocess(@files);
+	$self->log->crossvalidate( @{$json_files} );
+}
+
+sub log {
+	my ( $self, $file ) = @_;
+
+	if ($file) {
+		$self->{log} = undef;
+	}
+
+	$self->{log} //= MIMOSA::Log->new(
+		data_file => $file // $self->{data_file},
+		fast_analysis => $self->{fast_analysis},
+		model         => $self->model,
+		merge_args    => $self->{merge_args}
+	);
+
+	return $self->{log};
+}
+
+sub assess_fits {
+	my ( $self, $hash, $param ) = @_;
+	my $errmap = $hash->{fit_guess}{$param};
+	my @errors = map { [ $_, $errmap->{$_} ] } keys %{$errmap};
+	@errors = sort { $a->[1]{rmsd} <=> $b->[1]{rmsd} } @errors;
+
+	my $min_err = $errors[0][1]{rmsd};
+	@errors = grep { $_->[1]{rmsd} <= 2 * $min_err } @errors;
+	my @function_types = map {
+		sprintf( '%s (%.f / %.2f%%)', $_->[0], $_->[1]{rmsd}, $_->[1]{smape} )
+	} @errors;
+
+	return @function_types;
+}
+
+sub printf_aggr {
+	my ( $self, $hash, $key, $unit ) = @_;
+
+	$hash = $hash->{$key};
+
+	if ( exists $hash->{median_goodness}{smape} ) {
+		printf(
+			"  %s: static error: %.2f%% / %.f %s  (σ = %.f)\n",
+			$key,
+			$hash->{median_goodness}{smape},
+			$hash->{median_goodness}{mae},
+			$unit, $hash->{std_inner}
+		);
+
+#printf("  %s: median %.f (%.2f / %.2f%%), mean %.f (%.2f / %.2f%%), σ %.f %s\n",
+#	$key,
+#	$hash->{median},
+#	$hash->{median_goodness}{mae}   // -1,
+#	$hash->{median_goodness}{smape} // -1,
+#	$hash->{mean},
+#	$hash->{mean_goodness}{mae}   // -1,
+#	$hash->{mean_goodness}{smape} // -1,
+#	$hash->{std_inner},
+#	$unit
+#);
+	}
+	else {
+		printf(
+			"  %s: static error: %.f %s  (σ = %.f)\n",
+			$key, $hash->{median_goodness}{mae},
+			$unit, $hash->{std_inner}
+		);
+
+		#printf(
+		#	"  %s: median %.f (%.2f), mean %.f (%.2f), σ %.f %s\n",
+		#	$key, $hash->{median}, $hash->{median_goodness}{mae},
+		#	$hash->{mean}, $hash->{mean_goodness}{mae},
+		#	$hash->{std_inner}, $unit
+		#);
+	}
+}
+
+sub printf_aggr_tex {
+	my ( $self, $hash, $key, $unit, $divisor) = @_;
+
+	$hash = $hash->{$key};
+
+	if ($unit eq 'ms' and $hash->{median} < 1e3) {
+		$unit = '\us';
+		$divisor = 1;
+	}
+	elsif ($unit eq '\uJ' and $hash->{median} < 1e6) {
+		$unit = 'nJ';
+		$divisor = 1e3;
+	}
+	elsif ($unit eq '\uW' and $hash->{median} >= 1e3) {
+		$unit = 'mW';
+		$divisor = 1e3;
+	}
+
+	use locale;
+
+	printf(' & & \unit[%.3g]{%s}', $hash->{median} / $divisor, $unit);
+}
+
+sub printf_count_tex {
+	my ( $self, $hash, $key ) = @_;
+
+	if ($hash) {
+		$hash = $hash->{$key};
+
+		printf(' & %d', $hash->{count});
+	}
+	else {
+		printf(' & ');
+	}
+}
+
+sub printf_eval_tex {
+	my ( $self, $hash, $key, $unit, $divisor) = @_;
+
+	$hash = $hash->{$key};
+
+	if ($unit eq 'ms' and $hash->{median_goodness}{mae} < 1e3) {
+		$unit = '\us';
+		$divisor = 1;
+	}
+	if ($unit eq '\uJ' and $hash->{median_goodness}{mae} < 1e6) {
+		$unit = 'nJ';
+		$divisor = 1e3;
+	}
+
+	use locale;
+
+	printf("\n%20s & \\unit[%.3g]{%s} & \\unit[%.2g]{\\%%}",
+		q{},
+		$hash->{median_goodness}{mae} / $divisor, $unit,
+		$hash->{median_goodness}{smape} // -1
+	);
+}
+
+sub printf_goodness {
+	my ( $self, $modval, $hash, $key, $unit ) = @_;
+
+	$hash = $hash->{$key};
+
+	if ( exists $hash->{goodness}->{smape} ) {
+		printf(
+"  %s: model %.f %s, log ~=%.f / µ=%.f %s, mean absolute error %.2f %s (%.2f%%)\n",
+			$key,                     $modval,
+			$unit,                    $hash->{median},
+			$hash->{mean},            $unit,
+			$hash->{goodness}->{mae}, $unit,
+			$hash->{goodness}{smape}
+		);
+	}
+	else {
+		printf(
+"  %s: model %.f %s, log ~=%.f / µ=%.f %s, mean absolute error %.2f %s\n",
+			$key, $modval, $unit, $hash->{median}, $hash->{mean}, $unit,
+			$hash->{goodness}->{mae}, $unit );
+	}
+}
+
+sub printf_online_goodness {
+	my ( $self, $hash, $key, $unit ) = @_;
+
+	$hash = $hash->{$key};
+
+	if ( exists $hash->{goodness}->{smape} ) {
+		printf(
+"  %s: ~=%.f / µ=%.f %s, mean absolute error %.2f %s (%.2f%%)\n",
+			$key,                     $hash->{median},
+			$hash->{mean},            $unit,
+			$hash->{goodness}->{mae}, $unit,
+			$hash->{goodness}{smape}
+		);
+	}
+	else {
+		printf(
+"  %s: ~=%.f / µ=%.f %s, mean absolute error %.2f %s\n",
+			$key, $hash->{median}, $hash->{mean}, $unit,
+			$hash->{goodness}->{mae}, $unit );
+	}
+}
+
+sub printf_clip {
+	my ( $self, $hash ) = @_;
+
+	if ( $hash->{clip}{max} > 0.01 ) {
+		printf(
+			"  WARNING: Up to %.f%% clipping in power measurements (avg %.f%%)"
+			  . ", results are unreliable\n",
+			$hash->{clip}{max} * 100,
+			$hash->{clip}{mean} * 100
+		);
+	}
+}
+
+sub printf_parameterized {
+	my ( $self, $hash, $key ) = @_;
+	$hash = $hash->{$key};
+
+	my $std_global    = $hash->{std_inner};
+	my $std_ind_param = $hash->{std_param};
+	my $std_ind_trace = $hash->{std_trace};
+	my $std_by_param  = $hash->{std_by_param};
+	my $std_by_trace  = $hash->{std_by_trace} // {};
+	my $param_ratio;
+	my $trace_ratio;
+
+	if ( $std_global > 0 ) {
+		$param_ratio = $std_ind_param / $std_global;
+	}
+	if ( $std_ind_param > 0) {
+		$trace_ratio = $std_ind_trace / $std_ind_param;
+	}
+
+	if (    $std_global > 10
+		and $param_ratio < 0.5
+		and not exists $hash->{function}{user} )
+	{
+		printf( "  %s: should be parameterized (%.2f / %.2f = %.3f)\n",
+			$key, $std_ind_param, $std_global, $param_ratio );
+	}
+	if (
+		(
+			   $std_global < 10
+			or $param_ratio > 0.5
+		)
+		and exists $hash->{function}{user}
+	  )
+	{
+		printf( "  %s: should not be parameterized (%.2f / %.2f = %.3f)\n",
+			$key, $std_ind_param, $std_global,
+			$param_ratio ? $param_ratio : 0 );
+	}
+
+	if ( $std_global > 10 and $trace_ratio < 0.5 ) {
+		printf(
+			"  %s: model insufficient, depends on trace (%.2f / %.2f = %.3f)\n",
+			$key, $std_ind_trace, $std_ind_param, $trace_ratio );
+	}
+
+	if ( $std_global < 10 ) {
+		return;
+	}
+
+	for my $param ( sort keys %{$std_by_param} ) {
+		my $std_this = $std_by_param->{$param};
+		my $ratio    = $std_ind_param / $std_this;
+		my $status   = 'does not depend';
+		my $fline    = q{};
+		if ( $ratio < 0.6 ) {
+			$status = 'might depend';
+			$fline  = q{, probably };
+			$fline .= join( ' or ', $self->assess_fits( $hash, $param ) );
+		}
+		if ( $ratio < 0.3 ) {
+			$status = 'depends';
+		}
+		if ($fline) {
+			printf( "  %s: %s on %s (%.2f / %.2f = %.3f%s)\n",
+				$key, $status, $param, $std_ind_param, $std_this, $ratio,
+				$fline );
+		}
+	}
+
+	for my $transition ( sort keys %{$std_by_trace} ) {
+		my $std_this = $std_by_trace->{$transition};
+		my $ratio = $std_ind_trace / $std_this;
+		if ($ratio < 0.4) {
+			printf(
+"  %s: depends on presence of %s in trace (%.2f / %.2f = %.3f)\n",
+				$key, $transition, $std_ind_trace, $std_this, $ratio );
+		}
+	}
+}
+
+sub printf_fit {
+	my ( $self, $hash, $key, $unit ) = @_;
+	$hash = $hash->{$key};
+
+	if ( exists $hash->{function}{user} ) {
+		if ( exists $hash->{function}{user}{error} ) {
+			printf( "  user-specifed %s function could not be fitted: %s\n",
+				$key, $hash->{function}{user}{error} );
+		}
+		else {
+			printf(
+				"  user-specifed %s function fit error: %.2f%% / %.f %s\n",
+				$key,
+				$hash->{function}{user}{fit}{smape} // -1,
+				$hash->{function}{user}{fit}{mae}, $unit
+			);
+		}
+	}
+	if ( exists $hash->{function}{estimate} ) {
+		if ( exists $hash->{function}{estimate}{error} ) {
+			printf( "  estimated %s function could not be fitted: %s\n",
+				$key, $hash->{function}{estimate}{error} );
+		}
+		else {
+			printf(
+				"  estimated %s function fit error: %.2f%% / %.f %s\n",
+				$key,
+				$hash->{function}{estimate}{fit}{smape} // -1,
+				$hash->{function}{estimate}{fit}{mae}, $unit
+			);
+		}
+	}
+	if ( exists $hash->{param_mean_goodness} ) {
+		printf(
+			"  %s: mean/ssr-fit LUT error: %.2f%% / %.f %s / %.f\n",
+			$key,
+			$hash->{param_mean_goodness}{smape} // -1,
+			$hash->{param_mean_goodness}{mae}, $unit,
+			$hash->{param_mean_goodness}{rmsd}
+		);
+	}
+	if ( exists $hash->{param_median_goodness} ) {
+		printf(
+			"  %s: median/static LUT error: %.2f%% / %.f %s / %.f\n",
+			$key,
+			$hash->{param_median_goodness}{smape} // -1,
+			$hash->{param_median_goodness}{mae}, $unit,
+			$hash->{param_mean_goodness}{rmsd}
+		);
+	}
+}
+
+sub assess_model {
+	my ($self) = @_;
+
+	for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
+		my $state = $self->{log}{aggregate}{state}{$name};
+
+		printf( "Assessing %s:\n", $name );
+
+		$self->printf_clip($state);
+		$self->printf_aggr( $state, 'power', 'µW' );
+		$self->printf_parameterized( $state, 'power' );
+		$self->printf_fit( $state, 'power', 'µW' );
+	}
+	for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
+		my $transition = $self->{log}{aggregate}{transition}{$name};
+
+		printf( "Assessing %s:\n", $name );
+
+		$self->printf_clip($transition);
+		$self->printf_aggr( $transition, 'duration',        'µs' );
+		$self->printf_parameterized( $transition, 'duration' );
+		$self->printf_fit( $transition, 'duration', 'µs' );
+		$self->printf_aggr( $transition, 'energy', 'pJ' );
+		$self->printf_parameterized( $transition, 'energy' );
+		$self->printf_fit( $transition, 'energy', 'pJ' );
+		$self->printf_aggr( $transition, 'rel_energy', 'pJ' );
+		$self->printf_parameterized( $transition, 'rel_energy' );
+		$self->printf_fit( $transition, 'rel_energy', 'pJ' );
+
+		if ( exists $transition->{timeout}{median} ) {
+			$self->printf_aggr( $transition, 'timeout', 'µs' );
+			$self->printf_parameterized( $transition, 'timeout' );
+			$self->printf_fit( $transition, 'timeout', 'µs' );
+		}
+	}
+
+}
+
+sub assess_model_tex {
+	my ($self) = @_;
+	say '\begin{tabular}{|c|rrr|r|}\\hline';
+	say 'Zustand & $\MmedP$ & & & $n$ \\\\\\hline';
+	for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
+		my $state = $self->{log}{aggregate}{state}{$name};
+
+		printf("\n%20s", $name);
+
+		$self->printf_aggr_tex( $state, 'power', '\uW', 1 );
+		$self->printf_eval_tex( $state, 'power', '\uW', 1 );
+		$self->printf_count_tex( $state, 'power' );
+		print " \\\\";
+	}
+	say '\end{tabular}\\\\';
+	say '\vspace{0.5cm}';
+	say '\begin{tabular}{|c|rr|rr|rr|r|}\\hline';
+	say 'Transition & & $\MmedE$ & & $\MmedF$ & & $\Mmeddur$ & $n$ \\\\\\hline';
+	for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
+		my $transition = $self->{log}{aggregate}{transition}{$name};
+
+		printf("\n%20s", $name);
+
+		$self->printf_aggr_tex( $transition, 'energy', '\uJ', 1e6 );
+		$self->printf_aggr_tex( $transition, 'rel_energy', '\uJ', 1e6 );
+		$self->printf_aggr_tex( $transition, 'duration', 'ms', 1e3 );
+		$self->printf_count_tex( $transition, 'energy' );
+		print " \\\\";
+		$self->printf_eval_tex( $transition, 'energy', '\uJ', 1e6 );
+		$self->printf_eval_tex( $transition, 'rel_energy', '\uJ', 1e6 );
+		$self->printf_eval_tex( $transition, 'duration', 'ms', 1e3 );
+		$self->printf_count_tex;
+		print " \\\\";
+	}
+	print "\\hline\n";
+	say '\end{tabular}';
+}
+
+sub assess_validation {
+	my ($self) = @_;
+
+	for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
+		my $state = $self->{log}{aggregate}{state}{$name};
+
+		printf( "Validating %s:\n", $name );
+		$self->printf_clip($state);
+		$self->printf_goodness( $self->model->get_state_power($name),
+			$state, 'power', 'µW' );
+		$self->printf_fit( $state, 'power', 'µW' );
+		$self->printf_online_goodness(
+			$state, 'online_power', 'µW' );
+		$self->printf_online_goodness(
+			$state, 'online_duration', 'µs' );
+	}
+	for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
+		my $transition = $self->{log}{aggregate}{transition}{$name};
+
+		printf( "Validating %s:\n", $name );
+		$self->printf_clip($transition);
+		$self->printf_goodness(
+			$self->model->get_transition_by_name($name)->{duration}{static},
+			$transition, 'duration', 'µs' );
+		$self->printf_goodness(
+			$self->model->get_transition_by_name($name)->{energy}{static},
+			$transition, 'energy', 'pJ' );
+		$self->printf_goodness(
+			$self->model->get_transition_by_name($name)->{rel_energy}{static},
+			$transition, 'rel_energy', 'pJ' );
+		if ( exists $transition->{timeout}{median} ) {
+
+			#$self->printf_goodness('?', $transition, 'timeout', 'µs');
+			$self->printf_fit( $transition, 'timeout', 'µs' );
+		}
+	}
+}
+
+sub update_model {
+	my ($self) = @_;
+
+	while ( my ( $name, $state ) = each %{ $self->{log}{aggregate}{state} } ) {
+		$self->model->set_state_power( $name, $state->{power}{median} );
+		for my $fname ( keys %{ $state->{power}{function} } ) {
+			$self->model->set_state_params(
+				$name, $fname,
+				$state->{power}{function}{$fname}{raw},
+				@{ $state->{power}{function}{$fname}{params} }
+			);
+		}
+	}
+	while ( my ( $name, $transition )
+		= each %{ $self->{log}{aggregate}{transition} } )
+	{
+		$self->model->set_transition_data(
+			$name,
+			$transition->{duration}{median},
+			$transition->{energy}{median},
+			$transition->{rel_energy}{median}
+		);
+		for my $key (qw(duration energy rel_energy timeout)) {
+			for my $fname ( keys %{ $transition->{$key}{function} } ) {
+				$self->model->set_transition_params(
+					$name, $key, $fname,
+					$transition->{$key}{function}{$fname}{raw},
+					@{ $transition->{$key}{function}{$fname}{params} }
+				);
+			}
+		}
+	}
+
+	$self->model->save;
+}
+
+sub reset_model {
+	my ($self) = @_;
+
+	$self->model->reset;
+	$self->model->save;
+}
+
+sub to_ah {
+	my ($self)       = @_;
+	my $class_name   = $self->{class_name};
+	my $repo         = $self->repo;
+	my $class_header = $repo->{class}{$class_name}{sources}[0]{file};
+
+	my @transition_names
+	  = grep { $_ ne q{?} } map { $_->{name} } $self->model->transitions;
+
+	my $trigger_port = $self->{trigger_port};
+	my $trigger_pin  = $self->{trigger_pin};
+
+	my $ignore_nested = q{};
+	my $adv_type      = 'execution';
+
+	if ( $self->{ignore_nested} ) {
+		$adv_type      = 'call';
+		$ignore_nested = "&& !within(\"${class_name}\")";
+	}
+
+	my $ah_buf = <<"EOF";
+
+#ifndef ${class_name}_DFA_AH
+#define ${class_name}_DFA_AH
+
+#include "drivers/dfa_driver.h"
+#include "drivers/gpio.h"
+#include "drivers/eUSCI_A/uart/prototype_uart.h"
+#include "${class_header}"
+
+pointcut InnerTransition() = execution("% ${class_name}::%(...)");
+
+EOF
+
+	if ( defined $trigger_port and defined $trigger_pin ) {
+
+		$ah_buf .= "aspect ${class_name}_Trigger {\n\n";
+
+		$ah_buf .= 'pointcut Transition() = "'
+		  . join( q{" || "},
+			map { "% ${class_name}::$_(...)" } @transition_names )
+		  . "\";\n\n";
+		$ah_buf .= <<"EOF";
+
+		advice execution("void initialize_devices()") : after() {
+			setOutput(${trigger_port}, ${trigger_pin});
+		}
+
+		advice ${adv_type}(Transition()) ${ignore_nested} : before() {
+			pinHigh(${trigger_port}, ${trigger_pin});
+		}
+		advice ${adv_type}(Transition()) ${ignore_nested} : after() {
+			/* 22 = 10.2us delay @ 16MHz */
+			/* 32 = 14.6us delay @ 16MHz */
+			/* 64 = 28.6us delay @ 16MHz */
+			/* 160 = 50.6us delay @ 16MHz */
+			for (unsigned int i = 0; i < 64; i++)
+				asm volatile("nop");
+			pinLow(${trigger_port}, ${trigger_pin});
+		}
+
+		advice execution(Transition()) : order("${class_name}_DFA", "${class_name}_Trigger");
+
+EOF
+
+		if ( $self->{ignore_nested} ) {
+			for my $transition ( $self->model->transitions ) {
+				if ( $transition->{level} eq 'epilogue' ) {
+					$ah_buf .= <<"EOF";
+
+		advice execution("% ${class_name}::$transition->{name}(...)") : before() {
+			pinHigh(${trigger_port}, ${trigger_pin});
+		}
+		advice execution("% ${class_name}::$transition->{name}(...)") : after() {
+			for (unsigned int i = 0; i < 64; i++)
+				asm volatile("nop");
+			pinLow(${trigger_port}, ${trigger_pin});
+		}
+
+EOF
+				}
+			}
+		}
+		$ah_buf .= "};\n\n";
+	}
+
+	$ah_buf .= "aspect ${class_name}_DFA {\n\n";
+
+	for my $transition ( $self->model->transitions ) {
+		if ( $transition->{name} ne q{?} ) {
+			my $dest_state_id
+			  = $self->model->get_state_id( $transition->{destination} );
+			if ( $transition->{level} eq 'user' ) {
+				$ah_buf .= <<"EOF";
+
+		advice ${adv_type}("% ${class_name}::$transition->{name}(...)") ${ignore_nested} : after() {
+			tjp->target()->passTransition(${class_name}::statepower[tjp->target()->state],
+			$transition->{rel_energy}{static}, $transition->{id},
+			${dest_state_id});
+		};
+
+EOF
+			}
+			else {
+				$ah_buf .= <<"EOF";
+
+		advice execution("% ${class_name}::$transition->{name}(...)") : after() {
+			tjp->target()->passTransition(${class_name}::statepower[tjp->target()->state],
+			$transition->{rel_energy}{static}, $transition->{id},
+			${dest_state_id});
+		};
+
+EOF
+			}
+		}
+	}
+
+	$ah_buf .= <<"EOF";
+
+};
+#endif
+
+EOF
+
+	return $ah_buf;
+}
+
+sub to_cc {
+	my ($self) = @_;
+	my $class_name = $self->{class_name};
+
+	my @state_enum = $self->model->get_state_enum;
+
+	my $buf
+	  = "DFA_Driver::power_uW_t ${class_name}::statepower[] = {"
+	  . join( ', ', map { $self->model->get_state_power($_) } @state_enum )
+	  . "};\n";
+
+	return $buf;
+}
+
+sub to_h {
+	my ($self) = @_;
+
+	my @state_enum = $self->model->get_state_enum;
+
+	my $buf
+	  = "public:\n"
+	  . "static power_uW_t statepower[];\n"
+	  . "enum State : uint8_t {"
+	  . join( ', ', @state_enum ) . "};\n";
+
+	return $buf;
+}
+
+sub to_tikz {
+	my ($self) = @_;
+
+	my $buf = <<'EOF';
+
+	\begin{tikzpicture}[node distance=3cm,>=stealth',bend angle=45,auto,->]
+		\tikzstyle{state}=[ellipse,thick,draw=black!75,minimum size=1cm,inner sep=2pt]
+
+EOF
+
+	my @state_enum = $self->model->get_state_enum;
+	my $initial    = shift(@state_enum);
+	my $prev       = $initial;
+	my $ini_name   = $initial;
+
+	if ( $ini_name eq 'UNINITIALIZED' ) {
+		$ini_name = '?';
+	}
+
+	$buf
+	  .= "\t\t\\node [state,initial,initial text={},initial where=left] ($initial) {\\small $ini_name};\n";
+	for my $state (@state_enum) {
+		$buf
+		  .= "\t\t\\node [state,right of=${prev}] ($state) {\\small $state};\n";
+		$prev = $state;
+	}
+
+	$buf .= "\n\t\t\\path\n";
+
+	for my $transition ( $self->model->transitions ) {
+		for my $origin ( @{ $transition->{origins} } ) {
+			my @edgestyles;
+			if ( $transition->{level} eq 'epilogue' ) {
+				push( @edgestyles, 'dashed' );
+			}
+			if ( $origin eq $transition->{destination} ) {
+				push( @edgestyles, 'loop above' );
+			}
+			my $edgestyle
+			  = @edgestyles ? '[' . join( q{,}, @edgestyles ) . ']' : q{};
+			$buf
+			  .= "\t\t  ($origin) edge ${edgestyle} node {$transition->{name}} ($transition->{destination})\n";
+		}
+	}
+	$buf .= "\t\t;\n";
+	$buf .= "\t\\end{tikzpicture}\n";
+
+	return $buf;
+}
+
+sub to_test_ah {
+	my ($self) = @_;
+
+	my $buf = <<'EOF';
+
+/*
+ * Autogenerated code -- Manual changes are not preserved
+ * vim:readonly
+ */
+
+#ifndef DRIVEREVAL_AH
+#define DRIVEREVAL_AH
+
+#include "DriverEval.h"
+#include "syscall/guarded_scheduler.h"
+
+aspect StartDFADriverEvalThread {
+	advice execution("void ready_threads()") : after() {
+		organizer.Scheduler::ready(driverEvalThread);
+	}
+};
+
+#endif
+
+EOF
+
+	return $buf;
+}
+
+sub to_test_cc {
+	my ($self) = @_;
+
+	my @runs       = $self->dfa->traces;
+	my @state_enum = $self->model->get_state_enum;
+	my $dfa        = $self->dfa->dfa;
+	my $num_runs   = @runs;
+	my $instance   = $self->repo->get_class_instance( $self->{class_name} );
+
+	my $state_duration = $self->{state_duration} // 1000;
+
+	my $buf = <<"EOF";
+
+/*
+ * Autogenerated code - Manual changes are not preserved.
+ * vim:readonly
+ */
+
+#include "DriverEval.h"
+#include "syscall/guarded_buzzer.h"
+
+DeclareThread(DriverEvalThread, driverEvalThread, 256);
+
+void DriverEvalThread::action()
+{
+	Guarded_Buzzer buzzer;
+
+	while (1) {
+
+		/* wait for MIMOSA calibration */
+		buzzer.sleep(12000);
+		buzzer.set(${state_duration});
+
+
+EOF
+
+	$buf .= $self->model->startup_code;
+	$buf .= "${instance}.startIteration(${num_runs});\n";
+
+	for my $run (@runs) {
+		$buf .= "\t\t/* test run $run->{id} start */\n";
+		$buf .= "\t\t${instance}.resetLogging();\n";
+		# $buf .= "\t\t${instance}.resetAccounting();\n"; # TODO sinnvoll?
+		my $state = 0;
+		for my $transition ( grep { $_->{isa} eq 'transition' }
+			@{ $run->{trace} } )
+		{
+			my ( $cmd, @args ) = @{ $transition->{code} };
+			my ($new_state)
+			  = $dfa->successors( $state, ":${cmd}!" . join( '!', @args ) );
+			my $state_name     = $self->dfa->reduced_id_to_state($state);
+			my $new_state_name = $self->dfa->reduced_id_to_state($new_state);
+			$buf .= "\t\t/* Transition $state_name -> $new_state_name */\n";
+
+			if ( $self->model->get_transition_by_name($cmd)->{level} eq
+				'epilogue' )
+			{
+				$buf .= "\t\t/* wait for $cmd interrupt */\n";
+				$buf .= "\t\tbuzzer.sleep();\n";
+			}
+			else {
+				$buf .= sprintf( "\t\t%s.%s(%s);\n",
+					$instance, $cmd, join( ', ', @args ) );
+				$buf .= "\t\tbuzzer.sleep();\n";
+			}
+			$buf .= $self->model->after_transition_code;
+			$state = $new_state;
+		}
+		$buf .= "\t\t${instance}.dumpLog();\n\n";
+	}
+
+	$buf .= $self->model->shutdown_code;
+	$buf .= "${instance}.stopIteration(); }}\n";
+
+	return $buf;
+}
+
+sub to_test_h {
+	my ($self) = @_;
+
+	my $class_prefix
+	  = $self->repo->get_class_path_prefix( $self->{class_name} );
+
+	my $buf = <<"EOF";
+
+/*
+ * Autogenerated code -- Manual changes are not preserved
+ * vim:readonly
+ */
+
+#ifndef DRIVEREVAL_H
+#define DRIVEREVAL_H
+
+#include "${class_prefix}.h"
+#include "syscall/thread.h"
+
+class DriverEvalThread : public Thread {
+	public:
+		DriverEvalThread(void* tos) : Thread(tos) { }
+		void action();
+};
+
+extern DriverEvalThread driverEvalThread;
+
+#endif
+
+EOF
+
+	return $buf;
+}
+
+sub to_test_json {
+	my ($self) = @_;
+
+	return JSON->new->encode( [ $self->dfa->traces ] );
+}
+
+sub rm_acc_files {
+	my ($self) = @_;
+
+	for my $file ( $self->{ah_file}, $self->{cc_file}, $self->{h_file} ) {
+		if ( -e $file ) {
+			unlink($file);
+		}
+	}
+
+	return $self;
+}
+
+sub write_test_files {
+	my ($self) = @_;
+
+	my $prefix = $self->{prefix} . '/apps/DriverEval';
+
+	if ( not -d $prefix ) {
+		mkdir($prefix);
+	}
+
+	write_file( "${prefix}/DriverEval.ah",   $self->to_test_ah );
+	write_file( "${prefix}/DriverEval.cc",   $self->to_test_cc );
+	write_file( "${prefix}/DriverEval.h",    $self->to_test_h );
+	write_file( "${prefix}/DriverEval.json", $self->to_test_json );
+
+	# Old log may no longer apply to new test files
+	unlink("${prefix}/DriverLog.txt");
+
+	return $self;
+}
+
+sub rm_test_files {
+	my ($self) = @_;
+
+	my $prefix = $self->{prefix} . '/apps/DriverEval/DriverEval';
+
+	for my $file ( "${prefix}.ah", "${prefix}.cc", "${prefix}.h" ) {
+		if ( -e $file ) {
+			unlink($file);
+		}
+	}
+
+	return $self;
+}
+
+sub archive_files {
+	my ($self) = @_;
+
+	$self->{lp}{timestamp} //= DateTime->now( time_zone => 'Europe/Berlin' )
+	  ->strftime('%Y%m%d_%H%M%S');
+
+	my $tar = Archive::Tar->new;
+
+	my @eval_files = (
+		( map { "src/apps/DriverEval/DriverEval.$_" } (qw(ah cc h json)) ),
+		( map { "src/apps/DriverEval/DriverLog.$_" }  (qw(json txt)) ),
+	);
+
+	my @mim_files = grep { m{ \. mim }x } read_dir('.');
+
+	$tar->add_files( $self->{xml_file}, @eval_files, @mim_files );
+
+	$tar->add_data(
+		'setup.json',
+		JSON->new->encode(
+			{
+				excluded_states => $self->{excluded_states},
+				ignore_nested   => $self->{ignore_nested},
+				mimosa_offset   => $self->{mimosa_offset},
+				mimosa_shunt    => $self->{mimosa_shunt},
+				mimosa_voltage  => $self->{mimosa_voltage},
+				state_duration  => $self->{state_duration},
+				trace_filter    => $self->{trace_filter},
+				trace_revisit   => $self->{trace_revisit},
+				trigger_pin     => $self->{trigger_pin},
+				trigger_port    => $self->{trigger_port},
+			}
+		)
+	);
+
+	$tar->write("../data/$self->{lp}{timestamp}_$self->{class_name}.tar");
+
+	return $self;
+}
+
+sub write_acc_files {
+	my ($self) = @_;
+
+	write_file( $self->{ah_file}, $self->to_ah );
+	write_file( $self->{cc_file}, $self->to_cc );
+	write_file( $self->{h_file},  $self->to_h );
+
+	return $self;
+}
+
+sub launchpad_connect {
+	my ($self) = @_;
+
+	$self->{port_file} //= '/dev/ttyACM1';
+	$self->{port} = Device::SerialPort->new( $self->{port_file} )
+	  or croak("Error openig serial port $self->{port_file}");
+
+	$self->{port}->baudrate(115200);
+	$self->{port}->databits(8);
+	$self->{port}->parity('none');
+	$self->{port}->read_const_time(500);
+
+	return $self;
+}
+
+sub launchpad_flash {
+	my ($self) = @_;
+
+	my ( $make_buf, $prog_buf );
+
+	my $remake = harness(
+		[ 'make', '-B' ],
+		'<'  => \undef,
+		'>&' => \$make_buf,
+	);
+
+	my $make_program = harness(
+		[ 'make', 'program' ],
+		'<'  => \undef,
+		'>&' => \$prog_buf,
+	);
+
+	$remake->run
+	  or croak( 'make -B returned ' . $remake->full_result );
+	$make_program->run
+	  or croak( 'make program returned ' . $remake->full_result );
+
+	return $self;
+}
+
+sub launchpad_reset {
+	my ($self) = @_;
+
+	my $output_buffer;
+	my $make_reset = harness(
+		[ 'make', 'reset' ],
+		'<'  => \undef,
+		'>&' => \$output_buffer,
+	);
+
+	$make_reset->run
+	  or croak( 'make reset returned ' . $make_reset->full_result );
+
+	return $self;
+}
+
+sub launchpad_log_clean {
+	my ($self) = @_;
+
+	for my $file ( read_dir('.') ) {
+		if ( $file =~ m{ \. mim $ }x ) {
+			unlink($file);
+		}
+	}
+}
+
+sub launchpad_log_init {
+	my ($self) = @_;
+
+	$self->{lp}{run_id}      = 0;
+	$self->{lp}{sync}        = 0;
+	$self->{lp}{calibrating} = 0;
+	$self->{lp}{run_done}    = 0;
+	$self->{lp}{run}         = [];
+	$self->{lp}{log}         = [];
+	$self->{lp}{errors}      = [];
+	$self->{lp}{log_buf}     = q{};
+
+	$self->{lp}{re}{iter_start} = qr{
+		^ \[ EP \] \s iteration \s start, \s (?<runs> \d+ ) \s runs $
+	}x;
+	$self->{lp}{re}{iter_stop} = qr{
+		^ \[ EP \] \s iteration \s stop $
+	}x;
+	$self->{lp}{re}{run_start} = qr{
+		^ \[ EP \] \s run \s start $
+	}x;
+	$self->{lp}{re}{run_stop} = qr{
+		^ \[ EP \] \s run \s stop, \s energyUsed = (?<total_e> \S+) $
+	}x;
+	$self->{lp}{re}{transition} = qr{
+		^ \[ EP \] \s dt = (?<delta_t> \S+) \s de = (?<delta_e> \S+) \s
+		oldst = (?<old_state> \S+ ) \s trid = (?<transition_id> \S+ ) $
+	}x;
+
+	$self->launchpad_connect;
+
+	return $self;
+}
+
+sub launchpad_run_done {
+	my ($self) = @_;
+
+	if ( $self->{lp}{run_done} ) {
+		$self->{lp}{run_done} = 0;
+		return 1;
+	}
+	return 0;
+}
+
+sub launchpad_get_errors {
+	my ($self) = @_;
+
+	my @errors = @{ $self->{lp}{errors} };
+	$self->{lp}{errors} = [];
+	return @errors;
+}
+
+sub launchpad_log_is_synced {
+	my ($self) = @_;
+
+	return $self->{lp}{sync};
+}
+
+sub launchpad_log_status {
+	my ($self) = @_;
+
+	return ( $self->{lp}{iteration}, $self->{lp}{run_id},
+		$self->{lp}{num_runs} );
+}
+
+sub launchpad_log_read {
+	my ($self) = @_;
+
+	my $port = $self->{port};
+
+	my ( $count, $chars ) = $port->read(1024);
+
+	$self->{lp}{log_buf} .= $chars;
+
+	if ( not defined $count ) {
+		$port->close;
+		croak("Serial port was disconnected");
+	}
+	if ( $count > 0 ) {
+		my @lines = split( /\n\r/, $chars );
+		for my $line (@lines) {
+			$self->launchpad_parse_line($line);
+		}
+	}
+}
+
+sub merged_json {
+	my ($self) = @_;
+
+	my @traces = $self->dfa->traces;
+
+	for my $run ( @{ $self->{lp}{log} } ) {
+		my $trace_idx = $run->{id} - 1;
+		my $idx       = 0;
+
+		assert_is( $traces[$trace_idx]{id}, $run->{id} );
+		push(@{$traces[$trace_idx]{total_energy}}, $run->{total_energy});
+		for my $online_obj ( @{ $run->{trace} } ) {
+			my $plan_obj = $traces[$trace_idx]{trace}[$idx];
+
+			#printf("%-15s %-15s\n", $plan_obj->{name}, $online_obj->{name});
+
+			if ( not defined $plan_obj->{name} ) {
+
+				# The planned test run is done, but the hardware reported an
+				# epilogue-level transition before the next run was started.
+
+				$traces[$trace_idx]{trace}[$idx] = {
+					isa  => $online_obj->{isa},
+					name => $online_obj->{name},
+					parameter =>
+					  $traces[$trace_idx]{trace}[ $idx - 1 ]{parameter},
+				};
+				if (
+					exists $traces[$trace_idx]{trace}[ $idx - 1 ]
+					{final_parameter} )
+				{
+					$traces[$trace_idx]{trace}[$idx]{parameter}
+					  = $traces[$trace_idx]{trace}[ $idx - 1 ]{final_parameter};
+				}
+			}
+			else {
+				if ($online_obj->{isa} ne $plan_obj->{isa}) {
+					printf("Log merge: ISA mismatch (should be %s, is %s) at index %d#%d\n",
+						$plan_obj->{isa}, $online_obj->{isa}, $trace_idx, $idx);
+					exit(1);
+				}
+				if ( $plan_obj->{name} ne 'UNINITIALIZED' ) {
+					if ($online_obj->{name} ne $plan_obj->{name}) {
+						printf("Log merge: name mismatch (should be %s, is %s) at index %d#%d\n",
+						$plan_obj->{name}, $online_obj->{name}, $trace_idx, $idx);
+						exit(1);
+					}
+				}
+			}
+
+			push(
+				@{ $traces[$trace_idx]{trace}[$idx]{online} },
+				$online_obj->{online}
+			);
+
+			$idx++;
+		}
+	}
+
+	$self->{lp}{log} = [];
+
+	return @traces;
+}
+
+sub launchpad_parse_line {
+	my ( $self, $line ) = @_;
+
+	if ( $line =~ $self->{lp}{re}{iter_start} ) {
+		$self->{lp}{sync}        = 1;
+		$self->{lp}{run_id}      = 0;
+		$self->{lp}{num_runs}    = $+{runs};
+		$self->{lp}{calibrating} = 0;
+	}
+	elsif ( not $self->{lp}{sync} ) {
+		return;
+	}
+	elsif ( $line =~ $self->{lp}{re}{iter_stop} ) {
+		$self->{lp}{iteration}++;
+		$self->{lp}{calibrating} = 1;
+		write_file( '../kratos/src/apps/DriverEval/DriverLog.txt',
+			$self->{lp}{log_buf} );
+		write_file(
+			'../kratos/src/apps/DriverEval/DriverLog.json',
+			JSON->new->encode( [ $self->merged_json ] )
+		);
+	}
+	elsif ( $line =~ $self->{lp}{re}{run_start} ) {
+		$self->{lp}{run_id}++;
+		$self->{lp}{run} = [];
+	}
+	elsif ( $line =~ $self->{lp}{re}{run_stop} ) {
+		$self->{lp}{run_done} = 1;
+		push(
+			@{ $self->{lp}{log} },
+			{
+				id    => $self->{lp}{run_id},
+				trace => [ @{ $self->{lp}{run} } ],
+				total_energy => 0 + $+{total_e},
+			}
+		);
+	}
+	elsif ( $line =~ $self->{lp}{re}{transition} ) {
+		push(
+			@{ $self->{lp}{run} },
+			{
+				isa    => 'state',
+				name   => ( $self->model->get_state_enum )[ $+{old_state} ],
+				online => {
+					time   => 0 + $+{delta_t},
+					energy => 0 + $+{delta_e},
+					power  => 0 + $+{delta_e} / $+{delta_t},
+				},
+			},
+			{
+				isa => 'transition',
+				name =>
+				  $self->model->get_transition_by_id( $+{transition_id} )
+				  ->{name},
+				online => {
+					timeout => 0 + $+{delta_t},
+				},
+			},
+		);
+	}
+	else {
+		$self->{lp}{sync} = 0;
+		push( @{ $self->{lp}{errors} }, "Cannot parse $line" );
+	}
+
+}
+
+1;
diff --git a/lib/Kratos/DFADriver/DFA.pm b/lib/Kratos/DFADriver/DFA.pm
new file mode 100644
index 0000000..ef834e0
--- /dev/null
+++ b/lib/Kratos/DFADriver/DFA.pm
@@ -0,0 +1,251 @@
+package Kratos::DFADriver::DFA;
+
+use strict;
+use warnings;
+use 5.020;
+
+use parent 'Class::Accessor';
+
+use FLAT::DFA;
+use Math::Cartesian::Product;
+
+Kratos::DFADriver::DFA->mk_ro_accessors(qw(model));
+
+our $VERSION = '0.00';
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	my $self = \%opt;
+
+	bless( $self, $class );
+
+	return $self;
+}
+
+sub set_model {
+	my ( $self, $model ) = @_;
+
+	$self->{model} = $model;
+
+	return $self;
+}
+
+sub reduced_id_to_state {
+	my ( $self, $id ) = @_;
+
+	if ( not( $self->{excluded_states} and @{ $self->{excluded_states} } ) ) {
+		return $self->model->get_state_name($id);
+	}
+
+	my @excluded
+	  = map { $self->model->get_state_id($_) } @{ $self->{excluded_states} };
+	@excluded = reverse sort { $a <=> $b } @excluded;
+	my @state_enum = $self->model->get_state_enum;
+
+	for my $state (@excluded) {
+		splice( @state_enum, $state, 1 );
+	}
+
+	return $state_enum[$id];
+}
+
+sub dfa {
+	my ($self) = @_;
+
+	if ( exists $self->{dfa} ) {
+		return $self->{dfa};
+	}
+
+	my $dfa        = FLAT::DFA->new();
+	my @state_enum = $self->model->get_state_enum;
+
+	$dfa->add_states( scalar @state_enum );
+	$dfa->set_starting(0);
+	$dfa->set_accepting( $dfa->get_states );
+
+	for my $transition ( $self->model->transitions ) {
+		my $destination = $transition->{destination};
+		my @argtuples
+		  = cartesian { 1 } map { $_->{values} } @{ $transition->{parameters} };
+
+		# cartesian will return a one-element list containing a reference to
+		# an empty array if @{$transition->{parameters}} is empty
+
+		for my $argtuple (@argtuples) {
+			for my $origin ( @{ $transition->{origins} } ) {
+				$dfa->add_transition(
+					$self->model->get_state_id($origin),
+					$self->model->get_state_id($destination),
+					':' . $transition->{name} . '!' . join( '!', @{$argtuple} )
+				);
+			}
+		}
+	}
+
+	if ( $self->{excluded_states} and @{ $self->{excluded_states} } ) {
+		my @to_delete = map { $self->model->get_state_id($_) }
+		  @{ $self->{excluded_states} };
+		$dfa->delete_states(@to_delete);
+	}
+
+	$self->{dfa} = $dfa;
+
+	say $dfa->as_summary;
+
+	return $dfa;
+}
+
+sub traces {
+	my ($self) = @_;
+
+	# Warning: This function is not deterministic!
+	# Therefore, results are cached. When in doubt, reload traces / execution
+	# plan from DriverEval.json
+
+	if ( exists $self->{traces} ) {
+		return @{ $self->{traces} };
+	}
+
+	my $max_iter       = $self->{trace_revisit} // 2;
+	my $dfa            = $self->dfa;
+	my @state_enum     = $self->model->get_state_enum;
+	my $next           = $dfa->new_deepdft_string_generator($max_iter);
+	my $state_duration = $self->{state_duration} // 1000;
+	my $trace_id       = 1;
+
+	my ( @raw_runs, @traces );
+	my $filter_re;
+
+	if ( $self->{trace_filter} and @{ $self->{trace_filter} } ) {
+		my @res;
+		for my $filter ( @{ $self->{trace_filter} } ) {
+			my $re = $filter;
+			$re =~ s{,}{![^:]*:}g;
+			$re =~ s{$}{![^:]*)};
+			$re =~ s{^}{(^};
+			push( @res, $re );
+		}
+		$filter_re = join( q{|}, @res );
+	}
+
+	while ( my $run = $next->() ) {
+		$run = substr( $run, 1 );
+		if ( $filter_re and not $run =~ m{$filter_re} ) {
+			next;
+		}
+		@raw_runs = grep { $_ ne substr( $run, 0, length($_) ) } @raw_runs;
+		push( @raw_runs, $run );
+	}
+
+	if ( @raw_runs == 0 ) {
+		say STDERR "--trace-filter did not match any run. Aborting.";
+		exit 1;
+	}
+
+	@raw_runs = sort @raw_runs;
+
+	for my $run_str (@raw_runs) {
+		my @trace;
+		my %param           = $self->model->parameter_hash;
+		my $state           = 0;
+		my $prev_transition = {};
+		for my $transition_str ( split( qr{ : }x, $run_str ) ) {
+			my ( $cmd, @args ) = split( qr{ ! }x, $transition_str );
+			my $state_name = $self->reduced_id_to_state($state);
+			my $transition = $self->model->get_transition_by_name($cmd);
+
+			push(
+				@trace,
+				{
+					isa  => 'state',
+					name => $state_name,
+					plan => {
+						time => $prev_transition->{timeout}{static}
+						  // $state_duration,
+						power  => $self->model->get_state_power($state_name),
+						energy => $self->model->get_state_power($state_name)
+						  * $state_duration,
+					},
+					parameter =>
+					  { map { $_ => $param{$_}{value} } keys %param, },
+				},
+				{
+					isa  => 'transition',
+					name => $cmd,
+					args => [@args],
+					code => [ $cmd, @args ],
+					plan => {
+						level   => $transition->{level},
+						energy  => $transition->{energy}{static},
+						timeout => $transition->{timeout}{static},
+					},
+					parameter =>
+					  { map { $_ => $param{$_}{value} } keys %param, },
+				},
+			);
+
+			$self->model->update_parameter_hash( \%param, $cmd, @args );
+
+			($state) = $dfa->successors( $state, ":${transition_str}" );
+			$prev_transition = $transition;
+			for my $extra_cmd (
+				$self->model->get_state_extra_transitions(
+					$state_enum[$state]
+				)
+			  )
+			{
+				$state_name = $self->reduced_id_to_state($state);
+				$transition = $self->model->get_transition_by_name($extra_cmd);
+				push(
+					@trace,
+					{
+						isa  => 'state',
+						name => $state_name,
+						plan => {
+							time => $prev_transition->{timeout}{static}
+							  // $state_duration,
+							power => $self->model->get_state_power($state_name),
+							energy => $self->model->get_state_power($state_name)
+							  * $state_duration,
+						},
+						parameter =>
+						  { map { $_ => $param{$_}{value} } keys %param, },
+					},
+					{
+						isa  => 'transition',
+						name => $extra_cmd,
+						args => [],
+						code => [$extra_cmd],
+						plan => {
+							level   => $transition->{level},
+							energy  => $transition->{energy}{static},
+							timeout => $transition->{timeout}{static},
+						},
+						parameter =>
+						  { map { $_ => $param{$_}{value} } keys %param, },
+					}
+				);
+				$prev_transition = $transition;
+			}
+		}
+
+    # required for unscheduled extra states and transitions caused by interrupts
+		$trace[-1]{final_parameter}
+		  = { map { $_ => $param{$_}{value} } keys %param, },
+		  push(
+			@traces,
+			{
+				id    => $trace_id,
+				trace => [@trace],
+			}
+		  );
+		$trace_id++;
+	}
+
+	$self->{traces} = [@traces];
+
+	return @traces;
+}
+
+1;
diff --git a/lib/Kratos/DFADriver/Model.pm b/lib/Kratos/DFADriver/Model.pm
new file mode 100644
index 0000000..67fb318
--- /dev/null
+++ b/lib/Kratos/DFADriver/Model.pm
@@ -0,0 +1,555 @@
+package Kratos::DFADriver::Model;
+
+use strict;
+use warnings;
+use 5.020;
+
+use parent 'Class::Accessor';
+
+use Carp;
+use Carp::Assert::More;
+use List::Util qw(first);
+use XML::LibXML;
+
+Kratos::DFADriver::Model->mk_ro_accessors(qw(class_name xml));
+
+our $VERSION = '0.00';
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	my $self = \%opt;
+
+	$self->{parameter}   = {};
+	$self->{states}      = {};
+	$self->{transitions} = [];
+	$self->{xml} = XML::LibXML->load_xml( location => $self->{xml_file} );
+
+	bless( $self, $class );
+
+	$self->parse_xml;
+
+	return $self;
+}
+
+sub parse_xml {
+	my ($self) = @_;
+
+	my $xml = $self->{xml};
+	my ($driver_node) = $xml->findnodes('/data/driver');
+	my $class_name  = $self->{class_name} = $driver_node->getAttribute('name');
+	my $state_index = 0;
+	my $transition_index = 0;
+
+	for my $state_node ( $xml->findnodes('/data/driver/states/state') ) {
+		my $name = $state_node->getAttribute('name');
+		my $power = $state_node->getAttribute('power') // 0;
+		$self->{states}{$name} = {
+			power => { static => 0+$power },
+			id    => $state_index,
+			node  => $state_node,
+		};
+
+		for my $fun_node ( $state_node->findnodes('./powerfunction/*') ) {
+			my $fname         = $fun_node->nodeName;
+			my $powerfunction = $fun_node->textContent;
+			$powerfunction =~ s{^ \n* \s* }{}x;
+			$powerfunction =~ s{\s* \n* $}{}x;
+			$powerfunction =~ s{ [\n\t]+ }{}gx;
+			$self->{states}{$name}{power}{function}{$fname}{raw}
+			  = $powerfunction;
+			$self->{states}{$name}{power}{function}{$fname}{node} = $fun_node;
+			my $attrindex = 0;
+
+			while ( $fun_node->hasAttribute("param${attrindex}") ) {
+				push(
+					@{
+						$self->{states}{$name}{power}{function}{$fname}{params}
+					},
+					$fun_node->getAttribute("param${attrindex}")
+				);
+				$attrindex++;
+			}
+		}
+
+		$state_index++;
+	}
+
+	for my $param_node ( $xml->findnodes('/data/driver/parameters/param') ) {
+		my $param_name    = $param_node->getAttribute('name');
+		my $function_name = $param_node->getAttribute('functionname');
+		my $function_arg  = $param_node->getAttribute('functionparam');
+		my $default       = $param_node->textContent;
+
+		$self->{parameter}{$param_name} = {
+			function => $function_name,
+			arg_name => $function_arg,
+			default  => $default,
+		};
+	}
+
+	for my $transition_node (
+		$xml->findnodes('/data/driver/transitions/transition') )
+	{
+		my @src_nodes      = $transition_node->findnodes('./src');
+		my ($dst_node)     = $transition_node->findnodes('./dst');
+		my ($level_node)   = $transition_node->findnodes('./level');
+		my @param_nodes    = $transition_node->findnodes('./param');
+		my @affected_nodes = $transition_node->findnodes('./affects/param');
+		my @parameters;
+		my %affects;
+
+		my @source_states = map { $_->textContent } @src_nodes;
+
+		for my $param_node (@param_nodes) {
+			my @value_nodes = $param_node->findnodes('./value');
+			my $param       = {
+				name   => $param_node->getAttribute('name'),
+				values => [ map { $_->textContent } @value_nodes ],
+			};
+			push( @parameters, $param );
+		}
+
+		for my $param_node (@affected_nodes) {
+			my $param_name  = $param_node->getAttribute('name');
+			my $param_value = $param_node->getAttribute('value');
+			$affects{$param_name} = $param_value;
+		}
+
+		my $transition = {
+			name        => $transition_node->getAttribute('name'),
+			duration    => { static => 0+($transition_node->getAttribute('duration') // 0) },
+			energy      => { static => 0+($transition_node->getAttribute('energy') // 0) },
+			rel_energy  => { static => 0+($transition_node->getAttribute('rel_energy') // 0) },
+			parameters  => [@parameters],
+			origins     => [@source_states],
+			destination => $dst_node->textContent,
+			level       => $level_node->textContent,
+			id          => $transition_index,
+			affects     => {%affects},
+			node        => $transition_node,
+		};
+
+		for my $fun_node ( $transition_node->findnodes('./timeoutfunction/*') )
+		{
+			my $name     = $fun_node->nodeName;
+			my $function = $fun_node->textContent;
+			$function =~ s{^ \n* \s* }{}x;
+			$function =~ s{\s* \n* $}{}x;
+			$transition->{timeout}{function}{$name}{raw}  = $function;
+			$transition->{timeout}{function}{$name}{node} = $fun_node;
+			my $attrindex = 0;
+			while ( $fun_node->hasAttribute("param${attrindex}") ) {
+				push(
+					@{ $transition->{timeout}{function}{$name}{params} },
+					$fun_node->getAttribute("param${attrindex}")
+				);
+				$attrindex++;
+			}
+		}
+
+		for my $fun_node ( $transition_node->findnodes('./durationfunction/*') )
+		{
+			my $name     = $fun_node->nodeName;
+			my $function = $fun_node->textContent;
+			$function =~ s{^ \n* \s* }{}x;
+			$function =~ s{\s* \n* $}{}x;
+			$transition->{duration}{function}{$name}{raw}  = $function;
+			$transition->{duration}{function}{$name}{node} = $fun_node;
+			my $attrindex = 0;
+			while ( $fun_node->hasAttribute("param${attrindex}") ) {
+				push(
+					@{ $transition->{duration}{function}{$name}{params} },
+					$fun_node->getAttribute("param${attrindex}")
+				);
+				$attrindex++;
+			}
+		}
+
+		for my $fun_node ( $transition_node->findnodes('./energyfunction/*') )
+		{
+			my $name     = $fun_node->nodeName;
+			my $function = $fun_node->textContent;
+			$function =~ s{^ \n* \s* }{}x;
+			$function =~ s{\s* \n* $}{}x;
+			$transition->{energy}{function}{$name}{raw}  = $function;
+			$transition->{energy}{function}{$name}{node} = $fun_node;
+			my $attrindex = 0;
+			while ( $fun_node->hasAttribute("param${attrindex}") ) {
+				push(
+					@{ $transition->{energy}{function}{$name}{params} },
+					$fun_node->getAttribute("param${attrindex}")
+				);
+				$attrindex++;
+			}
+		}
+
+		for my $fun_node ( $transition_node->findnodes('./rel_energyfunction/*') )
+		{
+			my $name     = $fun_node->nodeName;
+			my $function = $fun_node->textContent;
+			$function =~ s{^ \n* \s* }{}x;
+			$function =~ s{\s* \n* $}{}x;
+			$transition->{rel_energy}{function}{$name}{raw}  = $function;
+			$transition->{rel_energy}{function}{$name}{node} = $fun_node;
+			my $attrindex = 0;
+			while ( $fun_node->hasAttribute("param${attrindex}") ) {
+				push(
+					@{ $transition->{rel_energy}{function}{$name}{params} },
+					$fun_node->getAttribute("param${attrindex}")
+				);
+				$attrindex++;
+			}
+		}
+
+		push( @{ $self->{transitions} }, $transition );
+
+		$transition_index++;
+	}
+
+	if ( my ($node) = $xml->findnodes('/data/startup/code') ) {
+		$self->{startup}{code} = $node->textContent;
+	}
+	if ( my ($node) = $xml->findnodes('/data/after-transition/code') ) {
+		$self->{after_transition}{code} = $node->textContent;
+	}
+	for my $node ( $xml->findnodes('/data/after-transition/if') ) {
+		my $state = $node->getAttribute('state');
+		for my $transition ( $node->findnodes('./transition') ) {
+			my $name = $transition->getAttribute('name');
+			push( @{ $self->{after_transition}{in_state}{$state} }, $name );
+		}
+	}
+	if ( my ($node) = $xml->findnodes('/data/shutdown/code') ) {
+		$self->{shutdown}{code} = $node->textContent;
+	}
+
+	return $self;
+}
+
+sub reset {
+	my ($self) = @_;
+
+	for my $state (values %{$self->{states}}) {
+		$state->{node}->removeAttribute('power');
+		for my $list_node (@{$state->{node}->findnodes('./powerfunction')}) {
+			for my $fun_name (keys %{$state->{power}{function}}) {
+				my $fun_node = $state->{power}{function}{$fun_name}{node};
+				if ($fun_node->nodeName eq 'user') {
+					for my $attrnode ($fun_node->attributes) {
+						$attrnode->setValue(1);
+					}
+				}
+				else {
+					$list_node->removeChild($fun_node);
+				}
+			}
+		}
+	}
+	for my $transition (@{$self->{transitions}}) {
+		$transition->{node}->removeAttribute('duration');
+		$transition->{node}->removeAttribute('energy');
+		$transition->{node}->removeAttribute('rel_energy');
+		for my $list_node (@{$transition->{node}->findnodes('./timeoutfunction')}) {
+			for my $fun_name (keys %{$transition->{timeout}{function}}) {
+				my $fun_node = $transition->{timeout}{function}{$fun_name}{node};
+				if ($fun_node->nodeName eq 'user') {
+					for my $attrnode ($fun_node->attributes) {
+						$attrnode->setValue(1);
+					}
+				}
+				else {
+					$list_node->removeChild($fun_node);
+				}
+			}
+		}
+	}
+}
+
+sub set_state_power {
+	my ( $self, $state, $power ) = @_;
+
+	$power = sprintf( '%.f', $power );
+
+	printf( "state %-16s: adjust power %d -> %d µW\n",
+		$state, $self->{states}{$state}{power}{static}, $power );
+
+	$self->{states}{$state}{power}{static} = $power;
+	$self->{states}{$state}{node}->setAttribute( 'power', $power );
+}
+
+sub set_state_params {
+	my ( $self, $state, $fun_name, $function, @params ) = @_;
+	my $old_params = 'None';
+
+	if ( exists $self->{states}{$state}{power}{function}{$fun_name} ) {
+		$old_params = join( q{ },
+			@{ $self->{states}{$state}{power}{function}{$fun_name}{params} } );
+	}
+
+	printf( "state %-16s: adjust %s power function parameters [%s] -> [%s]\n",
+		$state, $fun_name, $old_params, join( q{ }, @params ) );
+
+	if ( not defined $self->{states}{$state}{power}{function}{$fun_name}{node} )
+	{
+		my ($fun_node)
+		  = $self->{states}{$state}{node}->findnodes('./powerfunction');
+		if ($fun_node) {
+			my $new_node = XML::LibXML::Element->new($fun_name);
+			$self->{states}{$state}{power}{function}{$fun_name}{node}
+			  = $new_node;
+			$fun_node->appendChild($new_node);
+		}
+		else {
+			say
+			  '  skipping XML write-back because of missing powerfunction node';
+			return;
+		}
+	}
+
+	if ( defined $function ) {
+		my $cdata_node = XML::LibXML::CDATASection->new($function);
+		$self->{states}{$state}{power}{function}{$fun_name}{node}
+		  ->removeChildNodes;
+		$self->{states}{$state}{power}{function}{$fun_name}{node}
+		  ->appendChild($cdata_node);
+	}
+
+	for my $i ( 0 .. $#params ) {
+		$self->{states}{$state}{power}{function}{$fun_name}{params}[$i]
+		  = $params[$i];
+		$self->{states}{$state}{power}{function}{$fun_name}{node}
+		  ->setAttribute( "param$i", $params[$i] );
+	}
+}
+
+sub set_transition_params {
+	my ( $self, $transition_name, $fun_type, $fun_name, $function, @params ) = @_;
+	my $transition = $self->get_transition_by_name($transition_name);
+	my $old_params = 'None';
+
+	if ( exists $transition->{$fun_type}{function}{$fun_name} ) {
+		$old_params = join( q{ },
+			@{ $transition->{$fun_type}{function}{$fun_name}{params} } );
+	}
+
+	printf(
+		"transition %-16s: adjust %s %s function parameters [%s] -> [%s]\n",
+		$transition_name, $fun_name, $fun_type, $old_params, join( q{ }, @params ) );
+
+	if ( not defined $transition->{$fun_type}{function}{$fun_name}{node} ) {
+		my ($fun_node) = $transition->{node}->findnodes("./${fun_type}function");
+		if ($fun_node) {
+			my $new_node = XML::LibXML::Element->new($fun_name);
+			$transition->{$fun_type}{function}{$fun_name}{node} = $new_node;
+			$fun_node->appendChild($new_node);
+		}
+		else {
+			say
+"  skipping XML write-back because of missing ${fun_type}function node";
+			return;
+		}
+	}
+
+	if ( defined $function ) {
+		my $cdata_node = XML::LibXML::CDATASection->new($function);
+		$transition->{$fun_type}{function}{$fun_name}{node}->removeChildNodes;
+		$transition->{$fun_type}{function}{$fun_name}{node}
+		  ->appendChild($cdata_node);
+	}
+
+	for my $i ( 0 .. $#params ) {
+		$transition->{$fun_type}{function}{$fun_name}{params}[$i] = $params[$i];
+		$transition->{$fun_type}{function}{$fun_name}{node}
+		  ->setAttribute( "param$i", $params[$i] );
+	}
+}
+
+sub set_transition_data {
+	my ( $self, $transition_name, $duration, $energy, $rel_energy ) = @_;
+
+	my $transition = $self->get_transition_by_name($transition_name);
+	$duration = sprintf( '%.f', $duration );
+	$energy = sprintf( '%.f', $energy );
+
+	printf( 'transition %-16s: adjust duration %d -> %d µs',
+		$transition->{name}, $transition->{duration}{static}, $duration);
+	$transition->{duration}{static} = $duration;
+	$transition->{node}->setAttribute('duration', $duration);
+
+	printf( ', absolute energy %d -> %d pJ',
+		$transition->{energy}{static}, $energy );
+
+	$transition->{energy}{static} = $energy;
+	$transition->{node}->setAttribute( 'energy', $energy );
+
+	if (defined $rel_energy) {
+		$rel_energy = sprintf('%.f', $rel_energy);
+		printf( ", relative energy %d -> %d pJ\n",
+			$transition->{rel_energy}{static}, $rel_energy );
+
+		$transition->{rel_energy}{static} = $rel_energy;
+		$transition->{node}->setAttribute( 'rel_energy', $rel_energy );
+	}
+	else {
+		print("\n");
+	}
+}
+
+sub save {
+	my ($self) = @_;
+
+	$self->{xml}->toFile( $self->{xml_file} );
+}
+
+sub parameter_hash {
+	my ($self) = @_;
+
+	for my $param_name ( keys %{ $self->{parameter} } ) {
+		$self->{parameter}{$param_name}{value}
+		  = $self->{parameter}{$param_name}{default};
+	}
+
+	return %{ $self->{parameter} };
+}
+
+sub update_parameter_hash {
+	my ( $self, $param_hash, $function, @args ) = @_;
+
+	my $transition = $self->get_transition_by_name($function);
+
+	for my $param ( keys %{ $transition->{affects} } ) {
+		$param_hash->{$param}{value} = $transition->{affects}{$param};
+	}
+
+	for my $i ( 0 .. $#args ) {
+		my $arg_name  = $transition->{parameters}[$i]{name};
+		my $arg_value = $args[$i];
+
+		for my $param_name ( keys %{ $self->{parameter} } ) {
+			if ( $self->{parameter}{$param_name}{arg_name} eq $arg_name ) {
+				$param_hash->{$param_name}{value} = $arg_value;
+			}
+		}
+	}
+}
+
+sub startup_code {
+	my ($self) = @_;
+
+	return $self->{startup}{code} // q{};
+}
+
+sub after_transition_code {
+	my ($self) = @_;
+
+	return $self->{after_transition}{code} // q{};
+}
+
+sub get_state_extra_transitions {
+	my ( $self, $state ) = @_;
+
+	return @{ $self->{after_transition}{in_state}{$state} // [] };
+}
+
+sub shutdown_code {
+	my ($self) = @_;
+
+	return $self->{shutdown}{code} // q{};
+}
+
+sub get_transition_by_name {
+	my ( $self, $name ) = @_;
+
+	my $transition = first { $_->{name} eq $name } @{ $self->{transitions} };
+
+	return $transition;
+}
+
+sub get_transition_by_id {
+	my ( $self, $id ) = @_;
+
+	return $self->{transitions}[$id];
+}
+
+sub get_state_id {
+	my ( $self, $name ) = @_;
+
+	return $self->{states}{$name}{id};
+}
+
+sub get_state_name {
+	my ( $self, $id ) = @_;
+
+	return ( $self->get_state_enum )[$id];
+}
+
+sub get_state_power {
+	my ( $self, $name ) = @_;
+
+	return $self->{states}{$name}{power}{static};
+}
+
+sub get_state_enum {
+	my ($self) = @_;
+
+	if ( not exists $self->{state_enum} ) {
+		@{ $self->{state_enum} }
+		  = sort { $self->{states}{$a}{id} <=> $self->{states}{$b}{id} }
+		  keys %{ $self->{states} };
+	}
+
+	return @{ $self->{state_enum} };
+}
+
+sub transitions {
+	my ($self) = @_;
+
+	return @{ $self->{transitions} };
+}
+
+sub TO_JSON {
+	my ($self) = @_;
+
+	my %state_copy
+	  = map { $_ => { %{ $self->{states}{$_} } } } keys %{ $self->{states} };
+	my %transition_copy
+	  = map { $_->{name} => { %{$_} } } @{ $self->{transitions} };
+
+	for my $val ( values %state_copy ) {
+		delete $val->{node};
+		if ( exists $val->{power}{function} ) {
+			$val->{power} = { %{ $val->{power} } };
+			$val->{power}{function} = { %{ $val->{power}{function} } };
+			for my $key ( keys %{ $val->{power}{function} } ) {
+				$val->{power}{function}{$key}
+				  = { %{ $val->{power}{function}{$key} } };
+				delete $val->{power}{function}{$key}{node};
+			}
+		}
+	}
+	for my $val ( values %transition_copy ) {
+		delete $val->{node};
+		for my $key (qw(duration energy rel_energy timeout)) {
+			if ( exists $val->{$key}{function} ) {
+				$val->{$key} = { %{ $val->{$key} } };
+				$val->{$key}{function} = { %{ $val->{$key}{function} } };
+				for my $ftype ( keys %{ $val->{$key}{function} } ) {
+					$val->{$key}{function}{$ftype}
+					= { %{ $val->{$key}{function}{$ftype} } };
+					delete $val->{$key}{function}{$ftype}{node};
+				}
+			}
+		}
+	}
+
+	my $json = {
+		parameter  => $self->{parameter},
+		state      => {%state_copy},
+		transition => {%transition_copy},
+	};
+
+	return $json;
+}
+
+1;