#!/usr/bin/perl -w # # Feed this the output from readlots # Note that the interval length determination is known to be slightly # buggy at least under certain adverse conditions. # Output format: # ,value during interval # / ,classification chars # @<1105296455.621813 55..59 5e S-= 1 I112 # ^interval ends just before \ decoded bit' `interpretation # `computed min and maxlength # Classification chars # S short interval # L long interval # U interval might have been short or long but we don't know # (interval is short iff actual length < 80) # followed by two chars which classify the measurement error etc. # first the min length is classified # < too short for NMRA decoder spec for interval (as classified) # - decoder must decode but power station may not produce, too short # = in spec # + decoder must decode but power station may not produce, too long # > too long for NMRA decoder spec for interval (as classified) # then the max length, just the same way. # # interpretations # Innn idle/preamble bit, number nnn # F ... framing bit indicates more data # is those already received # B () data bit no # includes byte under construction # P packet end bit of good packet, includes csum # EP () framing/decoding error use strict qw(vars refs); use IO::Handle; sub usec_from_to ($$) { my ($from,$to) = @_; # uses $from->{S}, $from->{U}, $to->{S}, $to->{U} my ($s,$u); $s= $to->{S} - $from->{S}; $u= $to->{U} - $from->{U}; die "interval $s.$u secs too big" if $s < -100 or $s > 100; return $s * 1000000 + $u; } #---------- bit stream (packet) decoder ---------- our ($idle_counter, $bitnum, @bytes); sub reset_packet_decoder () { $idle_counter= 0; } sub packet_decoder_error ($) { printf "EP (%s)\n", $_[0]; reset_packet_decoder(); } sub found_bit ($) { my ($bit) = @_; if (defined $idle_counter) { if ($bit) { $idle_counter++; printf "I%-4d\n", $idle_counter; return; } if ($idle_counter < 10) { packet_decoder_error("I only $idle_counter"); return; } undef $idle_counter; $bitnum= -1; @bytes= (); } if ($bitnum<0) { if ($bit) { my ($checksum,$byte); $checksum= 0; foreach $byte (@bytes) { $checksum ^= hex $byte; } if ($checksum) { $checksum= sprintf '%02x', $checksum; packet_decoder_error("csum err $checksum in @bytes"); return; } print "P @bytes\n"; $idle_counter= 0; return; } $bitnum= 7; print "F @bytes...\n"; push @bytes, '00'; return; } $b= hex $bytes[$#bytes]; $b |= ($bit << $bitnum); $bytes[$#bytes]= sprintf "%02x", $b; print "B @bytes($bitnum)\n"; $bitnum--; } #---------- interval -> bit decoder ---------- our (@valuefor); # @valuefor[0] = value for first half of a bit # @valuefor[1] = value for second half of a bit # undef: not seen yet our ($in_bit); # undef: not in a bit # S: in a short bit # L: in a long bit our ($bit_phase_determined); sub interval_mapchar ($$@) { # compares $len with values in @l in turn, selecting # first char from $chars if it is less than $l[0], # otherwise 2nd char from $chars if it is less than $l[1], # etc.; $chars should be one char longer than @l is long. my ($len, $chars, @l) = @_; while (@l && $len >= $l[0]) { shift @l; $chars =~ s/^.//; } return substr($chars,0,1); } sub reset_bit_decoder () { printf "-- restarting bit decoder --\n"; undef @valuefor; undef $in_bit; $bit_phase_determined= 0; reset_packet_decoder(); } sub found_interval ($$$) { my ($value, $minlen, $maxlen) = @_; die "$value $minlen $maxlen" if $minlen > $maxlen; printf "%6.2f .. %6.2f %s ", $minlen, $maxlen, $value; my ($class, $fudge_class); my (@nomlens,$min_char,$max_char,$nomlens_chars); my ($bit_half, $bit_value); # $minlen and $maxlen are actually differences of rounded values; # so there's an extra 1 us of slop in each of them (from 2x 0.5us # rounding error). Ie, real value satisfies # $minlen - 1 < $real_value < $maxlen + 1 if ($minlen > 80) { $class= 'L'; @nomlens= qw(90 95 10000 12000); } elsif ($maxlen < 80) { $class= 'S'; @nomlens= qw(52 55 61 64); } else { $class= 'U'; #urgh @nomlens= qw(52 55 61 64); } $nomlens_chars= '<-=+>'; $min_char= interval_mapchar($minlen-0.9, $nomlens_chars, @nomlens); $max_char= interval_mapchar($maxlen+0.9, $nomlens_chars, @nomlens); printf("%s%s%s", $class, $min_char, $max_char); if (defined $in_bit and (($class eq 'U') xor ($in_bit eq 'U'))) { $fudge_class= $class.$in_bit; $fudge_class =~ s/U//; $class= $in_bit= $fudge_class; printf("%s ",$fudge_class); } else { printf(" "); } if (defined $in_bit and $in_bit ne $class) { if ($bit_phase_determined) { printf("E (exp'd %s)\n", $in_bit); reset_bit_decoder(); return; } undef $in_bit; undef @valuefor; $bit_phase_determined= 1; } $bit_half= !!defined $in_bit; if (!exists $valuefor[$bit_half]) { $valuefor[$bit_half]= $value; } if ($valuefor[$bit_half] ne $value) { printf("E (%s, exp'd %s)\n", $bit_half ? '2nd' : '1st', $valuefor[$bit_half]); reset_bit_decoder(); return; } if ($bit_half) { undef $in_bit; if ($class eq 'U') { printf " E UU"; reset_packet_decoder(); return; } $bit_value= !!($class eq 'S'); printf " %d ", $bit_value; found_bit($bit_value); } else { $in_bit= $class; printf "\n"; } } #---------- interval scanner ---------- our ($begintmin,$begintmax); our ($lastt,$lastvalue); sub found_datapoint ($$) { my ($t,$value) = @_; # called when we find that $value was measured at $t if ($value > -0.01 && $value < 0.01) { return; # treat as zero, ignore } if (defined $lastt && $value * $lastvalue < 0) { if (defined $begintmin) { printf "@%10.2f ", $t; found_interval($value < 0 ? 'H' : 'L', $lastt-$begintmax, $t-$begintmin); } $begintmin= $lastt; $begintmax= $t; } $lastt= $t; $lastvalue= $value; } #---------- datapoint reader ---------- sub read_stdin() { reset_bit_decoder(); while () { last if STDIN->eof; next if m/^\;/; m/^\s*([-.0-9e]+)\s+([-.0-9e]+)\s*$/ or die "$_ ?"; found_datapoint($1 * 1e6, $2); } die $! if STDIN->error; } if (!@ARGV) { exec './display-nmra-decoded &1 |less'; die "$? $!"; } elsif (@ARGV==1 and $ARGV[0] eq '-') { read_stdin(); } else { die; } die $! if STDOUT->error;