parport/nmra-decode.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # Feed this the output from readlots
   4
   5 # Note that the interval length determination is known to be slightly
   6 # buggy at least under certain adverse conditions.
   7
   8 # Output format:
   9 #                                      ,value during interval
  10 #                                     / ,classification chars
  11 # @<1105296455.621813     55..59     5e S-=    1  I112
  12 # ^interval ends just before  \     decoded bit'  `interpretation
  13 #                              `computed min and maxlength
  14 # Classification chars
  15 #    S  short interval
  16 #    L  long interval
  17 #    U  interval might have been short or long but we don't know
  18 #   (interval is short iff actual length < 80)
  19 # followed by two chars which classify the measurement error etc.
  20 # first the min length is classified
  21 #    <  too short for NMRA decoder spec for interval (as classified)
  22 #    -  decoder must decode but power station may not produce, too short
  23 #    =  in spec
  24 #    +  decoder must decode but power station may not produce, too long
  25 #    >  too long for NMRA decoder spec for interval (as classified)
  26 # then the max length, just the same way.
  27 #
  28 # interpretations
  29 #      Innn                idle/preamble bit, number nnn
  30 #      F <bytes>...        framing bit indicates more data
  31 #                            <bytes> is those already received
  32 #      B <bytes>(<bitno>)  data bit no <bitno>
  33 #                            <bytes> includes byte under construction
  34 #      P <bytes>           packet end bit of good packet, <bytes> includes csum
  35 #      EP (<error msg>)    framing/decoding error
  36
  37 use strict qw(vars refs);
  38 use IO::Handle;
  39
  40 sub usec_from_to ($$) {
  41     my ($from,$to) = @_; # uses $from->{S}, $from->{U}, $to->{S}, $to->{U}
  42     my ($s,$u);
  43     $s= $to->{S} - $from->{S};
  44     $u= $to->{U} - $from->{U};
  45     die "interval $s.$u secs too big" if $s < -100 or $s > 100;
  46     return $s * 1000000 + $u;
  47 }
  48
  49 #---------- bit stream (packet) decoder ----------
  50
  51 our ($idle_counter, $bitnum, @bytes);
  52
  53 sub reset_packet_decoder () {
  54     $idle_counter= 0;
  55 }
  56
  57 sub packet_decoder_error ($) {
  58     printf "EP (%s)\n", $_[0];
  59     reset_packet_decoder();
  60 }
  61
  62 sub found_bit ($) {
  63     my ($bit) = @_;
  64     if (defined $idle_counter) {
  65         if ($bit) {
  66             $idle_counter++;
  67             printf "I%-4d\n", $idle_counter;
  68             return;
  69         }
  70         if ($idle_counter < 10) {
  71             packet_decoder_error("I only $idle_counter");
  72             return;
  73         }
  74         undef $idle_counter;
  75         $bitnum= -1;
  76         @bytes= ();
  77     }
  78     if ($bitnum<0) {
  79         if ($bit) {
  80             my ($checksum,$byte);
  81             $checksum= 0;
  82             foreach $byte (@bytes) {
  83                 $checksum ^= hex $byte;
  84             }
  85             if ($checksum) {
  86                 $checksum= sprintf '%02x', $checksum;
  87                 packet_decoder_error("csum err $checksum in @bytes");
  88                 return;
  89             }
  90             print "P @bytes\n";
  91             $idle_counter= 0;
  92             return;
  93         }
  94         $bitnum= 7;
  95         print "F @bytes...\n";
  96         push @bytes, '00';
  97         return;
  98     }
  99     $b= hex $bytes[$#bytes];
 100     $b |= ($bit << $bitnum);
 101     $bytes[$#bytes]= sprintf "%02x", $b;
 102     print "B @bytes($bitnum)\n";
 103     $bitnum--;
 104 }
 105
 106 #---------- interval -> bit decoder ----------
 107
 108 our (@valuefor);
 109 # @valuefor[0] = value for first half of a bit
 110 # @valuefor[1] = value for second half of a bit
 111 # undef: not seen yet
 112
 113 our ($in_bit);
 114 # undef: not in a bit
 115 # S: in a short bit
 116 # L: in a long bit
 117
 118 our ($bit_phase_determined);
 119
 120 sub interval_mapchar ($$@) {
 121     # compares $len with values in @l in turn, selecting
 122     # first char from $chars if it is less than $l[0],
 123     # otherwise 2nd char from $chars if it is less than $l[1],
 124     # etc.; $chars should be one char longer than @l is long.
 125     my ($len, $chars, @l) = @_;
 126     while (@l && $len >= $l[0]) {
 127         shift @l;
 128         $chars =~ s/^.//;
 129     }
 130     return substr($chars,0,1);
 131 }
 132
 133 sub reset_bit_decoder () {
 134     printf "-- restarting bit decoder --\n";
 135     undef @valuefor;
 136     undef $in_bit;
 137     $bit_phase_determined= 0;
 138     reset_packet_decoder();
 139 }
 140
 141 sub found_interval ($$$) {
 142     my ($value, $minlen, $maxlen) = @_;
 143     die "$value $minlen $maxlen" if $minlen > $maxlen;
 144
 145     my ($class, $fudge_class);
 146     my (@nomlens,$min_char,$max_char,$nomlens_chars);
 147     my ($bit_half, $bit_value);
 148
 149     # $minlen and $maxlen are actually differences of rounded values;
 150     # so there's an extra 1 us of slop in each of them (from 2x 0.5us
 151     # rounding error).  Ie, real value satisfies
 152     #    $minlen - 1 < $real_value < $maxlen + 1
 153
 154     if ($minlen > 80) {
 155         $class= 'L';
 156         @nomlens= qw(90 95 10000 12000);
 157     } elsif ($maxlen < 80) {
 158         $class= 'S';
 159         @nomlens= qw(52 55 61 64);
 160     } else {
 161         $class= 'U'; #urgh
 162         @nomlens= qw(52 55 61 64);
 163     }
 164     $nomlens_chars= '<-=+>';
 165     $min_char= interval_mapchar($minlen-0.9, $nomlens_chars, @nomlens);
 166     $max_char= interval_mapchar($maxlen+0.9, $nomlens_chars, @nomlens);
 167
 168     printf("%s%s%s",
 169            $class, $min_char, $max_char);
 170
 171     if (defined $in_bit and (($class eq 'U') xor ($in_bit eq 'U'))) {
 172         $fudge_class= $class.$in_bit;
 173         $fudge_class =~ s/U//;
 174         $class= $in_bit= $fudge_class;
 175         printf("%s ",$fudge_class);
 176     } else {
 177         printf("  ");
 178     }
 179
 180     if (defined $in_bit and $in_bit ne $class) {
 181         if ($bit_phase_determined) {
 182             printf("E (exp'd %s)\n", $in_bit);
 183             reset_bit_decoder();
 184             return;
 185         }
 186         undef $in_bit;
 187         undef @valuefor;
 188         $bit_phase_determined= 1;
 189     }
 190     $bit_half= !!defined $in_bit;
 191     if (!exists $valuefor[$bit_half]) {
 192         $valuefor[$bit_half]= $value;
 193     }
 194     if ($valuefor[$bit_half] ne $value) {
 195         printf("E (%s, exp'd %s)\n", $bit_half ? '2nd' : '1st',
 196                $valuefor[$bit_half]);
 197         reset_bit_decoder();
 198         return;
 199     }
 200
 201     if ($bit_half) {
 202         undef $in_bit;
 203         if ($class eq 'U') {
 204             printf " E UU";
 205             reset_packet_decoder();
 206             return;
 207         }
 208         $bit_value= !!($class eq 'S');
 209         printf "  %d  ", $bit_value;
 210         found_bit($bit_value);
 211     } else {
 212         $in_bit= $class;
 213         printf "\n";
 214     }
 215 }
 216
 217 #---------- interval scanner ----------
 218
 219 our (%interval,%last);
 220 # $now{V}           value at this instant
 221 # $now{S}           seconds
 222 # $now{U}           microseconds
 223 # $now{Slop}        slop in current transition; undef = no transition here
 224 # $last{V}          value at last instant               } undef =
 225 # $last{S}          time of last instant (seconds)      }    before first
 226 # $last{U}          time of last instant (microseconds) }    instant
 227 # $last{Slop}       irrelevant
 228 # $interval{V}      value in the current interval; undef = before first val
 229 # $interval{S}      } start of current interval
 230 # $interval{U}      }  undef = no transition found yet
 231 # $interval{Slop}   }
 232
 233 sub found_datapoint ($$$$) {
 234     # found_datapoint($s,$u,$value,$inacc) is called
 235     #  when we find that $value was measured at between $s.$u and $s.$u+$inacc
 236     my (%now) = (S => $_[0], U => $_[1], V => $_[2]);
 237     my ($inacc) = $_[3];
 238     my ($minlen,$maxlen);
 239
 240     if (exists $interval{V} and $now{V} ne $interval{V}) {
 241         # found a transition
 242         $now{Slop}= usec_from_to(\%last,\%now) + $inacc;
 243     }
 244     if (defined $now{Slop} and defined $interval{S}) {
 245         # found an interval
 246         $minlen= usec_from_to(\%interval,\%now) - $now{Slop};
 247         $maxlen= $minlen + $interval{Slop};
 248         printf("\@<%10d.%06d %6d..%-6d %s ",
 249                $now{S},$now{U}, $minlen,$maxlen, $interval{V});
 250         found_interval($interval{V}, $minlen, $maxlen);
 251     }
 252     if (defined $now{Slop}) { # found a transition ? mark it as last one
 253         %interval= %now;
 254     }
 255     if (!defined $interval{V}) { # if right at start, simply not current V
 256         $interval{V}= $now{V};
 257     }
 258     %last= %now;
 259 }
 260
 261 #---------- datapoint reader ----------
 262
 263 sub read_input_file() {
 264     my (%now,%last);
 265
 266     reset_bit_decoder();
 267
 268     while (<STDIN>) {
 269         last if STDIN->eof;
 270         m/^(\d+)\.(\d+) ([0-9a-f]{2})$/ or die "$_ ?";
 271
 272         %now= (S => $1,
 273                U => $2,
 274                V => $3);
 275         if (defined $last{V}) {
 276             found_datapoint($last{S}, $last{U}, $last{V},
 277                             usec_from_to(\%last, \%now));
 278         }
 279         %last= %now;
 280     }
 281     die $! if STDIN->error;
 282 }
 283
 284 read_input_file();
 285 die $! if STDOUT->error;