detpic/display-nmra-decoded

   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 printf "%6.2f .. %6.2f  %s  ", $minlen, $maxlen, $value;
 146
 147     my ($class, $fudge_class);
 148     my (@nomlens,$min_char,$max_char,$nomlens_chars);
 149     my ($bit_half, $bit_value);
 150
 151     # $minlen and $maxlen are actually differences of rounded values;
 152     # so there's an extra 1 us of slop in each of them (from 2x 0.5us
 153     # rounding error).  Ie, real value satisfies
 154     #    $minlen - 1 < $real_value < $maxlen + 1
 155
 156     if ($minlen > 80) {
 157         $class= 'L';
 158         @nomlens= qw(90 95 10000 12000);
 159     } elsif ($maxlen < 80) {
 160         $class= 'S';
 161         @nomlens= qw(52 55 61 64);
 162     } else {
 163         $class= 'U'; #urgh
 164         @nomlens= qw(52 55 61 64);
 165     }
 166     $nomlens_chars= '<-=+>';
 167     $min_char= interval_mapchar($minlen-0.9, $nomlens_chars, @nomlens);
 168     $max_char= interval_mapchar($maxlen+0.9, $nomlens_chars, @nomlens);
 169
 170     printf("%s%s%s",
 171            $class, $min_char, $max_char);
 172
 173     if (defined $in_bit and (($class eq 'U') xor ($in_bit eq 'U'))) {
 174         $fudge_class= $class.$in_bit;
 175         $fudge_class =~ s/U//;
 176         $class= $in_bit= $fudge_class;
 177         printf("%s ",$fudge_class);
 178     } else {
 179         printf("  ");
 180     }
 181
 182     if (defined $in_bit and $in_bit ne $class) {
 183         if ($bit_phase_determined) {
 184             printf("E (exp'd %s)\n", $in_bit);
 185             reset_bit_decoder();
 186             return;
 187         }
 188         undef $in_bit;
 189         undef @valuefor;
 190         $bit_phase_determined= 1;
 191     }
 192     $bit_half= !!defined $in_bit;
 193     if (!exists $valuefor[$bit_half]) {
 194         $valuefor[$bit_half]= $value;
 195     }
 196     if ($valuefor[$bit_half] ne $value) {
 197         printf("E (%s, exp'd %s)\n", $bit_half ? '2nd' : '1st',
 198                $valuefor[$bit_half]);
 199         reset_bit_decoder();
 200         return;
 201     }
 202
 203     if ($bit_half) {
 204         undef $in_bit;
 205         if ($class eq 'U') {
 206             printf " E UU";
 207             reset_packet_decoder();
 208             return;
 209         }
 210         $bit_value= !!($class eq 'S');
 211         printf "  %d  ", $bit_value;
 212         found_bit($bit_value);
 213     } else {
 214         $in_bit= $class;
 215         printf "\n";
 216     }
 217 }
 218
 219 #---------- interval scanner ----------
 220
 221 our ($begintmin,$begintmax);
 222 our ($lastt,$lastvalue);
 223
 224 sub found_datapoint ($$) {
 225     my ($t,$value) = @_;
 226     # called when we find that $value was measured at $t
 227
 228     if ($value > -0.01 && $value < 0.01) {
 229         return; # treat as zero, ignore
 230     }
 231
 232     if (defined $lastt && $value * $lastvalue < 0) {
 233         if (defined $begintmin) {
 234             printf "@%10.2f  ", $t;
 235             found_interval($value < 0 ? 'H' : 'L',
 236                            $lastt-$begintmax, $t-$begintmin);
 237         }
 238         $begintmin= $lastt;
 239         $begintmax= $t;
 240     }
 241     $lastt= $t;
 242     $lastvalue= $value;
 243 }
 244
 245 #---------- datapoint reader ----------
 246
 247 sub read_stdin() {
 248     reset_bit_decoder();
 249
 250     while (<STDIN>) {
 251         last if STDIN->eof;
 252         next if m/^\;/;
 253         m/^\s*([-.0-9e]+)\s+([-.0-9e]+)\s*$/ or die "$_ ?";
 254         found_datapoint($1 * 1e6, $2);
 255     }
 256     die $! if STDIN->error;
 257 }
 258
 259 if (!@ARGV) {
 260     exec './display-nmra-decoded <t.nmra.dat - 2>&1 |less';
 261     die "$? $!";
 262 } elsif (@ARGV==1 and $ARGV[0] eq '-') {
 263     read_stdin();
 264 } else {
 265     die;
 266 }
 267
 268 die $! if STDOUT->error;