<*+M2EXTENSIONS *>
<*-CHECKDIV *>
<*-CHECKRANGE *>
<*-COVERFLOW *>
<*-IOVERFLOW*>

<*+NOPTRALIAS*>
<*CPU="PENTIUM"*>
<*-DOREORDER *>
<* IF __GEN_C__ THEN *>
  <*-GENCTYPES*>
  <*+COMMENT*>
  <*-GENHISTORY*>
  <*-GENDEBUG*>
  <*-GENDATE*>
  <*-LINENO*>
  <*-CHECKINDEX*>
  <*-CHECKNIL *>
  <*-CHECKSET*>
  <*+GENCDIV*>
  <*-GENKRC*>
  <*+NOOPTIMIZE*>
  <*-GENSIZE*>
  <*-ASSERT*>
<* ELSE *>
  <*+GENHISTORY*>
  <*+GENDEBUG*>
  <*+LINENO*>
  <*+CHECKINDEX*>
  <*+CHECKNIL *>
  <*-CHECKSET*>
<* END *>


MODULE sondeudp; (* demodulate RS92 sonde (2400bit/s manchester)
                    and SRS-C34-C50 (2400Bd AFSK 2000/3800Hz
                    and DFM (1250bit/s manchester)
                    and RS41 (2400Bd GFSK)
                    and M10 M20 (4800 bit/s manchester)
                    and iMET (1200Bd AFSK 2200/1200Hz)
                    and MRZ (1200 manchester) and send as AXUDP by OE5DXL *)

IMPORT soundctl, udp;
--FROM stat IMPORT fstat, stat_t;

FROM osi IMPORT WrLn, WrStr, WrStrLn, WrInt, WrHex, Close, RdBin, WrBin, WrFixed,
                OpenRW, OpenWrite, usleep, realint, realcard, WrCard;

FROM aprsstr IMPORT StrToCard, StrToInt, TimeToStr, IntToStr, StrCmp, Assign, Append,
                    DateToStr, Length, CardToStr, StrToTime, FixToStr;

FROM SYSTEM IMPORT ADR, INT8, INT16, CARD16, CAST, SHIFT, CARD8, ADDRESS, FILL;

FROM osi IMPORT ALLOCATE, DEALLOCATE, pi, NextArg, time, IsFifo;

FROM math IMPORT log,cos,sin,tan,sqrt,atan;

FROM rsc IMPORT initrsc, decodersc;

--FROM flush IMPORT Flush;
--IMPORT reedsolomon;
(* link init_rs_char.o decode_rs_char.o *)
(* gcc  -o sondeudp Lib.o aprsstr.o filesize.o flush.o osi.o ptty.o rsc.o sondeudp.o soundctl.o symlink.o tcp.o timec.o udp.o init_rs_char.o decode_rs_char.o /usr/local/xds/lib/x86/libts.a /usr/local/xds/lib/x86/libxds.a -lm -lrt *)

TYPE TIME=CARDINAL;
     IPNUM=CARDINAL;
     UDPPORT=CARDINAL;

CONST
      VERSION="1.37c";

      GPSTIMECORR=18;                      (* leap seconds *)
      MAXCHAN=64;
      MONTIME=10;                          (* seconds till next monitor udp send per channel *)
      DAYSEC=60*60*24;
      CONTEXTLIFE=1800;                    (* seconds till forget context after last heared *)
      MAXACTIVE=300;                       (* limit active time of demodulator *)
      ADCBYTES=2;
      MAXLEN=9;                            (* data frame size c34 *)
      ADCBUFLEN=4096;
      BAUDSAMP=65536;
      PLLSHIFT=BAUDSAMP DIV 64;
      RAD=pi/180.0;
      FRAMELIFETIME=3;                     (* max seconds from frame sync to sending frame *)
      WATERLEN=5;
      cFREQ="f";                           (* watermark type freq *)
      cRAPPORT="r";                        (* watermark type dB *)
      cAFC="a";                            (* watermark type afc *)

      DFIRLEN=64;
      AFIRLEN=32;
      AOVERSAMP=16;                        (*16*)
      ASYNBITS=10;
      CALIBFRAME=CHR(65H);
      GPSFRAME=CHR(67H);
      UNKNOWN=CHR(68H);
      DATAFRAME=CHR(69H);
      DOVERSAMP=16;
      CIDTIMEOUT=3600;                     (* s to delete c34 sonde id *)
      DFIDTIMEOUT=900;                     (* s to delete dfm sonde id *)
      FLEN6=264;                           (* dfm06 frame len *)
      DFMSYN=045CFH;                       (* frame sync sequence *)
      FLENRS41=520;                        (* rs41  frame len *)  
      FLENR92=240;
      FLEN10=101;                          (* M10 framelen *)
      FLEN20=88;                           (* M20 framelen *)
      FLENC34=22;                          (* c34 frame len *)
      FLENIMET=20+30+55+1;                 (* IMET frame length *)
      FLENMP3=49;                          (* MP3H frame length *)
      FLENMEISEI=3+4*6;                    (* MEISEI header + bytes after fec *)
      M10SYN=649F20H;                      (* M10 sync *)
      M10SYN1=644900H;
      M20ASYN=452000H;                     (* M20 sync *)
      MP3COPIES=6;
      FLENMEISEIRAW=46*6;                  (* MEISEI bits per frame *)

--11111000 01000101 00100000 0111xxxx syn m20
--11111000 01100100 01001001 0000xxxx -syn1- 
--11111000 01100100 10011111 00100000 -syn- 

--11111000 01000101 00100000 11000000
--11111000 01000101 00100000 01111001
--11111000 01000101 00100000 10000100
--11111000 01000101 00100000 10001011
--11111000 01000101 00100000 11000000

(*
  rs41x 0x86, 0x35, 0xf4, 0x40, 0x93, 0xdf, 0x1a, 0x60
  rs41  0x10, 0xB6, 0xCA, 0x11, 0x22, 0x96, 0x12, 0xF8
*)
      RHEAD41="0000100001101101010100111000100001000100011010010100100000011111";
      EXOR41=ARRAY OF CARD8 { 96H, 83H, 3EH, 51H, 0B1H, 49H, 08H, 98H,
                         32H, 05H, 59H, 0EH, 0F9H, 44H, 0C6H, 26H,
                         21H, 60H, 0C2H, 0EAH, 79H, 5DH, 6DH, 0A1H,
                         54H, 69H, 47H, 0CH, 0DCH, 0E8H, 5CH, 0F1H,
                         0F7H, 76H, 82H, 7FH, 07H, 99H, 0A2H, 2CH,
                         93H, 7CH, 30H, 63H, 0F5H, 10H, 2EH, 61H,
                         0D0H, 0BCH, 0B4H, 0B6H, 06H, 0AAH, 0F4H, 23H,
                         78H, 06EH, 03BH, 0AEH, 0BFH, 7BH, 4CH, 0C1H};

TYPE
     SET8=SET OF [0..7];
     SET16=SET OF [0..15];
     SET32=SET OF [0..31];
     SET256=SET OF [0..255];

     FILENAME=ARRAY[0..1023] OF CHAR;
     CNAMESTR=ARRAY[0..8] OF CHAR;

     ADCWORD=INT16;

     AFIRTAB=ARRAY[0..AFIRLEN*AOVERSAMP-1] OF REAL;
     DFIRTAB=ARRAY[0..DFIRLEN*DOVERSAMP-1] OF REAL;
     DFIR=ARRAY[0..DFIRLEN-1] OF REAL;
     DFNAMES=RECORD
       start:CARD8;
       dat:ARRAY[0..1] OF CARD16;
       cnt:ARRAY[0..1] OF CARD8;
     END;

     pUDPTX=POINTER TO UDPTX;
     UDPTX=RECORD
       next:pUDPTX;
       ip                                   : IPNUM;
       destport                             : UDPPORT;
       udpfd                                : INTEGER
     END;

     ENABLE=(OFF, ALWAYS, SLEEP);

     R92=RECORD
       enabled                              : ENABLE;
       savecnt                              : INTEGER;
       pllshift, baudfine, manchestd        : INTEGER;
       noise, bitlev, lastu                 : REAL;
       cbit, oldd, plld, lastmanch          : BOOLEAN;
       rxbyte, rxbitc, rxp, headerrs        : CARDINAL;
       rxbuf                                : ARRAY[0..300] OF CHAR;
       afirtab                              : AFIRTAB;
       asynst                               : ARRAY[0..ASYNBITS-1] OF INTEGER;
       demodbaud,
       configbaud                           : CARDINAL;
     END;

     R41=RECORD
       enabled                              : ENABLE;
       savecnt                              : INTEGER;
       pllshift, baudfine                   : INTEGER;
       noise0, bitlev0,
       noise, bitlev                        : REAL;
       cbit, oldd, plld, rev, headok        : BOOLEAN;
       rxbyte, rxbitc, rxp                  : CARDINAL;
       rxbuf, fixbytes                      : ARRAY[0..FLENRS41-1+40] OF CHAR;
       fixcnt                               : ARRAY[0..FLENRS41-1+40] OF CARD8;
       afirtab                              : AFIRTAB;
       demodbaud,
       configbaud, synp                     : CARDINAL;
       synbuf                               : ARRAY[0..63] OF BOOLEAN;
      END;

     DFM6=RECORD
       frametimeok                          : BOOLEAN;
       id9, idcheck                         : CNAMESTR;
       idcnt                                : CARDINAL;
       lastdatesystime,
       frametime,
       idtime,
       timediff,
       actdate,
       lastdate,
       tused                                : TIME;

       idnum,
       num,
       numcnt,
       lastnum                              : CARDINAL;

(* check name *)
       idcnt0,
       idcnt1,
       idnew                                : CARDINAL;
       lastlat,
       lastlong                             : REAL;
(* check name *)

(* new df serial *)
       lastfrid,
       lastfrcnt,
       nameregok,
       nameregtop                           : CARDINAL;
       namereg                              : ARRAY[0..49] OF DFNAMES;
(* new df serial *)

       wasdate,txok,d9                      : BOOLEAN;
       synword                              : CARDINAL;
       cb, ch                               : ARRAY[0..7*8-1] OF BOOLEAN;
       db1, db2, dh1, dh2                   : ARRAY[0..13*8-1] OF BOOLEAN;
     END;
     DFM6A=RECORD
       enabled                              : ENABLE;
       savecnt                              : INTEGER;
       pllshift, baudfine, manchestd        : INTEGER;
       noise, bitlev, lastu                 : REAL;
       polarity, cbit, oldd,
       plld, lastmanch                      : BOOLEAN;
       rxp                                  : CARDINAL;
       rxbuf                                : ARRAY[0..33*8-1] OF BOOLEAN;
       afirtab                              : AFIRTAB;
       demodbaud,
       configbaud                           : CARDINAL;
     END;


     IMET=RECORD

(* check name *)
       idcnt,
       idnew                                : CARDINAL;
       lastlat,
       lastlong                             : REAL;
       idtime                               : TIME;
(* check name *)

     END;
     IMETA=RECORD
       enabled                              : ENABLE;
       savecnt                              : INTEGER;
       pllshift,
       baudfine,
       leveldcd                             : INTEGER;
       afskhighpass,
       freq,
       left,
       tcnt,
       afskmidfreq,
       afmid,
       noise, bitlev                        : REAL;
       cbit, oldd, plld                     : BOOLEAN;
       rxbyte, rxbitc, rxp, stopc           : CARDINAL;
       rxbuf                                : ARRAY[0..FLENIMET-1] OF CHAR;
       afirtab                              : AFIRTAB;

       dfirtab                              : DFIRTAB;
       dfir                                 : DFIR;

       dfin,
       confignyquist,
       configafskshift,
       configafskmid,
       demodbaud,
       configbaud,
       txbaud                               : CARDINAL;
       hipasscap                            : REAL;
     END;


     M1020=RECORD
       enabled                              : ENABLE;
       savecnt                              : INTEGER;

       pllshift, baudfine, manchestd        : INTEGER;
       bitlev, noise, lastu                 : REAL;
       cbit, oldd,
       plld, lastmanch,
       ism20,
       alternativ,
       txok                                 : BOOLEAN;
       rxb,
       rxp                                  : CARDINAL;
       rxbuf,
       fixbytes                             : ARRAY[0..FLEN10-1] OF CHAR;
       fixcnt                               : ARRAY[0..FLEN10-1] OF CARD8;
       afirtab                              : AFIRTAB;
       timefn                               : TIME; 
       synword1,
       synword                              : CARDINAL;
       demodbaud,
       configbaud                           : CARDINAL;
     END;


     SCID=RECORD
       id, idcheck                          : CNAMESTR;
       idtime                               : TIME;
       idcnt                                : CARDINAL;
     END;
     C34=RECORD
       id34, id50                           : SCID;
       idtime                               : TIME;
       idcnt                                : CARDINAL;
       tused                                : TIME;
       c50                                  : BOOLEAN;
     END;

     C34A=RECORD
       enabled                              : ENABLE;
       savecnt                              : INTEGER;
       pllshift,
       baudfine,
       leveldcd                             : INTEGER;
       afskhighpass,
       freq,
       left,
       tcnt,
       afskmidfreq,
       afmid,
       noise, bitlev                        : REAL;
       cbit, oldd, plld                     : BOOLEAN;
       rxbyte, rxbytec, rxbitc, rxp         : CARDINAL;
       rxbuf                                : ARRAY[0..MAXLEN-1] OF CHAR;
       afirtab                              : AFIRTAB;
       asynst                               : ARRAY[0..ASYNBITS-1] OF INTEGER;

       dfirtab                              : DFIRTAB;
       dfir                                 : DFIR;

       dfin,
       confignyquist,
       configafskshift,
       configafskmid,
       demodbaud,
       configbaud,
       txbaud                               : CARDINAL;
       hipasscap                            : REAL;
     END;

     MP3BUF=ARRAY[0..FLENMP3] OF CHAR;
     MP3FRAME=RECORD 
       dat                                  : MP3BUF;
       time                                 : TIME;
     END;
     MP3H=RECORD
       enabled                              : ENABLE;
       savecnt                              : INTEGER;
       pllshift, baudfine, manchestd        : INTEGER;
       noise, bitlev, lastu                 : REAL;
       dmeis,
       id1ok, id2ok, dateok,
       cbit, oldd, polarity,
       plld, lastmanch                      : BOOLEAN;
       gpsdate,
       timeatdate,
       gpstime,
       blocktime                            : TIME;
       id1,
       id2,
       blocknum,                             
       synword,
       copycnt,
       rxb,
       rxp                                  : CARDINAL;
       copybuf                              : ARRAY[0..MP3COPIES-1] OF MP3FRAME;
       afirtab                              : AFIRTAB;
       demodbaud,
       configbaud                           : CARDINAL;
     END;

     MEISEI=RECORD
       enabled                              : ENABLE;
       timeok                               : BOOLEAN;
       gpsdaytime,
       subtype,
       gpssum,
       gpstime,
       frametyp,
       lostsamps,
       synword,
       lastser                              : TIME;
       rxb                                  : CARDINAL;
       rxbuf                                : ARRAY[0..FLENMEISEIRAW-1] OF BOOLEAN;
       ser                                  : ARRAY[0..10] OF CHAR;
       config                               : ARRAY[0..127] OF RECORD
                                                d:CARDINAL;
                                                t:TIME;
                                              END;
     END;


     pNONAMES=POINTER TO NONAMES;
     NONAMES=RECORD
       next                  : pNONAMES; 
       lastvalid             : TIME;
       chname                : CARDINAL;
       dfm6                  : DFM6;
       c34                   : C34;
       imet                  : IMET;
     END;

     CHAN=RECORD
       admax, admin          : INTEGER;
       afir                  : ARRAY[0..AFIRLEN-1] OF REAL;
       configequalizer       : INTEGER;
       udptx                 : pUDPTX;
       squelch,
       mycallc               : CARDINAL;
       framestarttime        : TIME;
       myssid                : CHAR;

       waterbyte             : CARD8;    
       waterword, 
       waterbits             : CARDINAL;
       waterdata,
       watertemp             : ARRAY[0..WATERLEN-1] OF RECORD cmd:CHAR; dat:CARDINAL END; 
       watersend             : TIME;
       waterok               : BOOLEAN;
       chlabel               : CARDINAL;
       lastmon               : TIME;
       r92                   : R92;
       r41                   : R41;
       m10                   : M1020;
       c34a                  : C34A;
       dfm6a                 : DFM6A;
       imeta                 : IMETA;
       mp3h                  : MP3H;
       meisei                : MEISEI;
       nonames               : pNONAMES;
     END;


VAR soundfd, debfd        : INTEGER;
    dfmoldname,
    abortonsounderr,
    waterenabled,
    nosendsdr,
    verb, verb2           : BOOLEAN; 
    dfmidoldthreshold,
    dfmidchgthreshold,
    dfmidthreshold,
    getst, i, afin, 
    soundbufs, 
    maxsoundbufs, adcrate, 
    adcbuflen,
    adcbufrd,
    adcbufsamps,
    savelevel,
    sampcount,
    fragmentsize          : CARDINAL;
    soundfn               : FILENAME;
    chan                  : ARRAY[0..MAXCHAN-1] OF CHAN;
    adcbufsampx,
    maxchannels,
    cfgchannels           : CARDINAL;
    monitorudp            : pUDPTX;
    adcbuf                : ARRAY[0..ADCBUFLEN-1] OF ADCWORD;
    dfmnametyp            : CARDINAL;
    rxlabel               : ARRAY[0..4] OF CHAR;
    oldnonames            : pNONAMES;
    CRCTAB                : ARRAY[0..255] OF SET16;
    CRC32TAB              : ARRAY[0..255] OF SET32;
test1, test2:CARDINAL;
tset:ARRAY[0..255] OF CARD16;

PROCEDURE Error(text:ARRAY OF CHAR);
BEGIN
  WrStr(text); WrStrLn(" error abort");
  HALT
END Error;

PROCEDURE GenCRC32tab;

CONST POLY=SET32{26,23,22,16,12,11,10,8,7,5,4,2,1,0};

VAR i, j:CARDINAL;
    crc:CARDINAL;
    revpoly:SET32;
BEGIN
  revpoly:=SET32{};
  FOR i:=0 TO 31 DO IF i IN POLY THEN INCL(revpoly, 31-i) END; END;

  FOR i:=0 TO 255 DO
    crc:=i;
    FOR j:=0 TO 7 DO
      IF ODD(crc) THEN crc:=CAST(CARDINAL, CAST(SET32, crc DIV 2)/revpoly);
      ELSE crc:=crc DIV 2 END;
    END;
    CRC32TAB[255-i]:=CAST(SET32, crc)/SET32{24..31};
  END;
END GenCRC32tab;

PROCEDURE crc32(VAR crc:CARDINAL; byte:CARD8);
BEGIN
  crc:=CAST(CARDINAL, SHIFT(CAST(SET32, crc), -8)
  /CRC32TAB[CAST(CARDINAL, CAST(SET32, crc) / CAST(SET32, byte) * SET32{0..7})]);
END crc32;


PROCEDURE Hamming(VAR f:ARRAY OF REAL);
VAR i:CARDINAL;
BEGIN
  FOR i:=0 TO HIGH(f) DO f[i]:=f[i]*(0.54+0.46*cos(pi*(FLOAT(i)/FLOAT(1+HIGH(f))))) END;
END Hamming;


PROCEDURE initdfir(VAR dfirtab:DFIRTAB; fg:CARDINAL);

VAR i,f:CARDINAL;
    t:ARRAY[0..DFIRLEN*DOVERSAMP DIV 2-1] OF REAL;
    f1, e:REAL;
BEGIN
  FOR i:=0 TO HIGH(t) DO t[i]:=0.5 END;

  f1:=FLOAT(fg*DFIRLEN)/FLOAT(adcrate);
  FOR f:=1 TO TRUNC(f1)+1 DO
    e:=1.0;
    IF f=TRUNC(f1)+1 THEN e:=f1-FLOAT(TRUNC(f1)) END;
    FOR i:=0 TO HIGH(t) DO t[i]:=t[i]+e*cos(pi*FLOAT(i*f)/FLOAT(HIGH(t)+1)) END;
  END;

  Hamming(t);

  FOR i:=0 TO HIGH(t) DO t[i]:=t[i]*(0.54+0.46*cos(pi*(FLOAT(i)/FLOAT(1+HIGH(t))))) END;
  FOR i:=0 TO HIGH(t) DO dfirtab[HIGH(t)+i]:=t[i]; dfirtab[HIGH(t)-i]:=t[i]; END;

END initdfir;


PROCEDURE initafir(VAR atab:AFIRTAB; F0, F1:CARDINAL; eq:REAL);
VAR i,f:CARDINAL;
    t:ARRAY[0..AFIRLEN*AOVERSAMP DIV 2-1] OF REAL;
    e,f0,f1:REAL;
BEGIN
  f0:=FLOAT(F0*AFIRLEN)/FLOAT(adcrate);
  f1:=FLOAT(F1*AFIRLEN)/FLOAT(adcrate);

  FOR i:=0 TO HIGH(t) DO t[i]:=0.0 END;

  FOR f:=TRUNC(f0) TO TRUNC(f1)+1 DO
    e:=1.0 + eq*(FLOAT(f)/(FLOAT((F0+F1)*AFIRLEN)/FLOAT(adcrate))*2.0-1.0);
(*
    e:=1.0 + eq*(FLOAT(f)/FLOAT((F0+F1)*AFIRLEN DIV adcrate)*2.0-1.0);
*)
    IF e<0.0 THEN e:=0.0 END;
    IF f=TRUNC(f0) THEN e:=e*(1.0-(f0-FLOAT(TRUNC(f0)))) END;
    IF f=TRUNC(f1)+1 THEN e:=e*(f1-FLOAT(TRUNC(f1))) END;
(*
IF eq<>0 THEN IO.WrFixed(e,2,2);IO.WrLn; END;
*)
    IF f=0 THEN
      FOR i:=0 TO HIGH(t) DO t[i]:=t[i]+e*0.5 END;
    ELSE
      FOR i:=0 TO HIGH(t) DO t[i]:=t[i] + e*cos(pi*FLOAT(i*f)/FLOAT(HIGH(t)+1)) END;
    END;
  END;

  Hamming(t);
  FOR i:=0 TO HIGH(t) DO atab[HIGH(t)+i]:=t[i]; atab[HIGH(t)-i]:=t[i]; END;


  IF F0>0 THEN          (* make dc level zero *)
    e:=0.0;
    FOR i:=0 TO HIGH(atab) DO e:=e+atab[i] END;
    e:=e/FLOAT(HIGH(atab)+1);
    FOR i:=0 TO HIGH(atab) DO atab[i]:=atab[i]-e END;
  END;


(*
IO.WrLn;
FOR i:=0 TO HIGH(atab) DO IO.WrFixed(atab[i], 2,8) END;
IO.WrLn;
*)

(*
IF eq<>0.0 THEN
debfd:=FIO.Create("/tmp/ta.raw");
FOR i:=0 TO HIGH(atab) DO f:=VAL(INTEGER, atab[i]*1000.0); FIO.WrBin(debfd,f,2) END;
FIO.Close(debfd);
END;
*)

END initafir;


PROCEDURE SetMixer(mixfn:ARRAY OF CHAR; chan, left, right:CARDINAL);
VAR fd:INTEGER;
BEGIN
  fd:=OpenRW(mixfn);
  IF fd>=0 THEN
    IF chan=255 THEN chan:=soundctl.recnum() END;
    soundctl.setmixer(fd, chan, ASH(right, 8) + left);
  ELSE WrStr(mixfn); Error(" open") END
END SetMixer;


PROCEDURE OpenSound;
VAR i,s:INTEGER;
BEGIN
  soundfd:=OpenRW(soundfn);
  IF soundfd>=0 THEN
    IF maxchannels<2 THEN 
      IF soundctl.samplesize(soundfd, 16)<0 THEN             (* 8, 16 *)
        IF NOT IsFifo(soundfd) THEN Error("sound must be pipe or oss") END;
      ELSE
        i:=soundctl.channels(soundfd, maxchannels+1);    (* 1, 2  *)
        i:=soundctl.setfragment(soundfd, fragmentsize);     (* 2^bufsize * 65536*bufs*)
        IF i<>0 THEN WrStr("sound setfragment returns "); WrInt(i,1); WrLn END;
        i:=soundctl.sampelrate(soundfd, adcrate);        (* 8000..48000 *)
        s:=soundctl.getsampelrate(soundfd);
        IF s<>VAL(INTEGER, adcrate) THEN
          WrStr("sound device returns "); WrInt(s,1); WrStrLn("Hz!");
        END;
      END;
    END;
  ELSIF abortonsounderr THEN WrStr(soundfn); Error(" open") END;
END OpenSound;


PROCEDURE packcall(cs:ARRAY OF CHAR; VAR cc:CARDINAL; VAR ssid:CHAR):BOOLEAN;
VAR i,j,s:CARDINAL;
    c:CHAR;
BEGIN
  cs[HIGH(cs)]:=0C;
  cc:=0;
  s:=0;
  i:=0;
  FOR j:=0 TO 5 DO
    cc:=cc*37;
    c:=cs[i];
    IF (c>="A") & (c<="Z") THEN INC(cc, ORD(c)-ORD("A")+1); INC(i);
    ELSIF (c>="0") & (c<="9") THEN INC(cc, ORD(c)-ORD("0")+27); INC(i);
    ELSIF (c<>0C) & (c<>"-") THEN RETURN FALSE END;

  END;
  IF cs[i]="-" THEN                                 (* ssid *)
    INC(i);
    c:=cs[i];
    IF (c>="0") & (c<="9") THEN
      INC(s, ORD(c)-ORD("0"));
      INC(i);
      c:=cs[i];
      IF (c>="0") & (c<="9") THEN s:=s*10 + ORD(c)-ORD("0") END;
    END;
    IF s>15 THEN RETURN FALSE END;

  ELSIF cs[i]<>0C THEN RETURN FALSE END;

  ssid:=CHR(s);
  RETURN (cc>0)
END packcall;

PROCEDURE GetIp(h:ARRAY OF CHAR; VAR ip:IPNUM; VAR port:UDPPORT):INTEGER;
VAR i, n, p:CARDINAL;
    ok:BOOLEAN;
BEGIN
  p:=0;
  h[HIGH(h)]:=0C;
  ip:=0;
  FOR i:=0 TO 4 DO
    n:=0;
    ok:=FALSE;
    WHILE (h[p]>="0") & (h[p]<="9") DO
      ok:=TRUE;
      n:=n*10+ORD(h[p])-ORD("0");
      INC(p);
    END;
    IF NOT ok THEN RETURN -1 END;
    IF i<3 THEN
      IF (h[p]<>".") OR (n>255) THEN RETURN -1 END;

      ip:=ip*256+n;
    ELSIF i=3 THEN
      ip:=ip*256+n;
      IF (h[p]<>":") OR (n>255) THEN RETURN -1 END;

    ELSIF n>65535 THEN RETURN -1 END;

    port:=n;
    INC(p);
  END;  
  RETURN udp.openudp()
END GetIp;


PROCEDURE ExtractWord(VAR w,s:ARRAY OF CHAR);
VAR i,j:CARDINAL;
BEGIN
  w[0]:=0C;
  i:=0;
  WHILE (i<=HIGH(s)) & (s[i]<>0C) & (s[i]<>":") DO
    IF i<=HIGH(w) THEN w[i]:=s[i] END;
    INC(i);
  END;
  
  IF i<=HIGH(w) THEN w[i]:=0C END;

  j:=0;
  IF (i<=HIGH(s)) & (s[i]<>0C) THEN 
    INC(i);
    WHILE (i<=HIGH(s)) & (s[i]<>0C) DO
      s[j]:=s[i];
      INC(i);
      INC(j);
    END;
  END;
  s[j]:=0C;
END ExtractWord;

PROCEDURE Config;
VAR i,c:CARDINAL;
BEGIN
  FOR c:=0 TO HIGH(chan) DO

    WITH chan[c].r92 DO
      configbaud:=4800;
      demodbaud:=2*configbaud*BAUDSAMP DIV adcrate;
      initafir(afirtab, 0, 2800, VAL(REAL, chan[c].configequalizer)/100.0);
      baudfine:=0;
      noise:=0.0;
      bitlev:=0.0;
      cbit:=FALSE;
      rxp:=0;
      rxbitc:=0;
      manchestd:=0; 
      lastmanch:=FALSE;
      rxbyte:=0;
      FOR i:=0 TO HIGH(asynst) DO asynst[i]:=0 END;
    END;

    WITH chan[c].r41 DO
      configbaud:=4800;
      demodbaud:=2*configbaud*BAUDSAMP DIV adcrate;
      initafir(afirtab, 0, 2800, VAL(REAL, chan[c].configequalizer)/100.0);
      baudfine:=0;
      noise:=0.0;
      bitlev:=0.0;
      cbit:=FALSE;
      rxp:=0;
      rxbitc:=0;
      rxbyte:=0;
      synp:=0;
    END;

    WITH chan[c].dfm6a DO
      configbaud:=2500;
      demodbaud:=2*configbaud*BAUDSAMP DIV adcrate;
      initafir(afirtab, 0, 1900, VAL(REAL, chan[c].configequalizer)/100.0);
      baudfine:=0;
      noise:=0.0;
      bitlev:=0.0;
      cbit:=FALSE;
      rxp:=FLEN6;            (* out of fram, wait for sync *)
      manchestd:=0;
      polarity:=FALSE;
    END;

    WITH chan[c].m10 DO
      configbaud:=9600;
      demodbaud:=2*configbaud*BAUDSAMP DIV adcrate;
      initafir(afirtab, 0, 5000, VAL(REAL, chan[c].configequalizer)/100.0);
      baudfine:=0;
      noise:=0.0;
      bitlev:=0.0;
      cbit:=FALSE;
      rxp:=FLEN10;            (* out of fram, wait for sync *)
      manchestd:=0;
      txok:=FALSE;
    END;

    WITH chan[c].c34a DO
      txbaud:=configbaud*BAUDSAMP DIV adcrate;
      demodbaud:=txbaud*2;

      afskmidfreq:=FLOAT(configafskmid)*2.0/FLOAT(adcrate);

      initafir(afirtab, configafskmid-configafskshift DIV 2-configbaud DIV 4,
               configafskmid+configafskshift DIV 2+configbaud DIV 4,
               VAL(REAL, chan[c].configequalizer)/100.0);
      initdfir(dfirtab, configbaud*confignyquist DIV 100);

      baudfine:=0;
      left:=0.0;
      tcnt:=0.0;
      freq:=0.0;
      dfin:=0;
      cbit:=FALSE;
      rxp:=0;
      rxbitc:=0;
    END;

    WITH chan[c].imeta DO
      txbaud:=configbaud*BAUDSAMP DIV adcrate;
      demodbaud:=txbaud*2;

      afskmidfreq:=FLOAT(configafskmid)*2.0/FLOAT(adcrate);

      initafir(afirtab, configafskmid-configafskshift DIV 2-configbaud DIV 4,
               configafskmid+configafskshift DIV 2+configbaud DIV 4,
               VAL(REAL, chan[c].configequalizer)/100.0);
      initdfir(dfirtab, configbaud*confignyquist DIV 100);

      baudfine:=0;
      left:=0.0;
      tcnt:=0.0;
      freq:=0.0;
      dfin:=0;
      cbit:=FALSE;
      rxp:=0;
      rxbitc:=0;
    END;

    WITH chan[c].mp3h DO
      configbaud:=2400;
      demodbaud:=2*configbaud*BAUDSAMP DIV adcrate;
      initafir(afirtab, 0, 1900, VAL(REAL, chan[c].configequalizer)/100.0);
      baudfine:=0;
      noise:=0.0;
      bitlev:=0.0;
      cbit:=FALSE;
      polarity:=FALSE;
      copycnt:=0;
      rxp:=FLENMP3;            (* out of frame, wait for sync *)
      manchestd:=0;
    END;

    WITH chan[c].meisei DO
      rxb:=FLENMEISEIRAW;            (* out of frame, wait for sync *)
    END;
  END;
END Config;


PROCEDURE Parms;
VAR err:BOOLEAN;
    h, h1, mixfn, pipefn:FILENAME;
    kissbufs, cnum, left, right, ch: CARDINAL;
    inum   : INTEGER;
    channel: CARDINAL;
    utx    : pUDPTX;
    chanset: BOOLEAN;
    mycall : ARRAY[0..10] OF CHAR;
    myc    : CARDINAL;
    mys    : CHAR;
    enab   : ENABLE;

BEGIN
  err:=FALSE;
  abortonsounderr:=FALSE;
  nosendsdr:=FALSE;
  waterenabled:=TRUE;  
  adcrate:=22050;
  adcbuflen:=1024;
  fragmentsize:=11;
  maxchannels:=0;
  cfgchannels:=1;                      (* fix 1 channel *)
  debfd:=-1;
  chanset:=FALSE;
  dfmnametyp:=512;
  dfmidoldthreshold:=1;
  dfmidchgthreshold:=3;
  dfmidthreshold:=1;
  rxlabel:="";
  dfmoldname:=FALSE;
  savelevel:=0;
  FOR channel:=0 TO HIGH(chan) DO
    WITH chan[channel].r92 DO
      enabled:=SLEEP;
      pllshift:=PLLSHIFT;
    END;
    WITH chan[channel].r41 DO
      enabled:=SLEEP;
      pllshift:=PLLSHIFT;
    END;
    WITH chan[channel].dfm6a DO
      enabled:=SLEEP;
      pllshift:=PLLSHIFT;
    END;
    WITH chan[channel].c34a DO
      enabled:=SLEEP;
      pllshift:=PLLSHIFT*14;
      confignyquist:=65;
      afskhighpass:=0.0;

      configbaud:=2400;
      configafskshift:=1800;
      configafskmid:=3800;
    END;
    WITH chan[channel].imeta DO
      enabled:=SLEEP;
      pllshift:=PLLSHIFT*3;
      confignyquist:=65;
      afskhighpass:=0.0;

      configbaud:=1200;
      configafskshift:=1000;
      configafskmid:=1700;
    END;

    WITH chan[channel].m10 DO
      enabled:=SLEEP;
      pllshift:=PLLSHIFT*4;
    END;

    WITH chan[channel].mp3h DO
      enabled:=SLEEP;
      pllshift:=PLLSHIFT;
    END;

    WITH chan[channel].meisei DO
      enabled:=SLEEP;
    END;

    WITH chan[channel] DO
      configequalizer:=0;
      udptx:=NIL;
      mycallc:=0;
    END;
  END;
  channel:=0;
  
  COPY("/dev/dsp", soundfn);
  COPY("/dev/mixer", mixfn);
  LOOP
    NextArg(h);
    IF h[0]=0C THEN EXIT END;
    IF ((h[0]="-") OR (h[0]="+")) & (h[1]<>0C) & (h[2]=0C) THEN
      IF h[0]="+" THEN enab:=ALWAYS ELSE enab:=OFF END;

      IF h[1]="a" THEN abortonsounderr:=TRUE

      ELSIF h[1]="2" THEN
        IF chanset THEN                                           (* set only 1 chan *)
          chan[channel].mp3h.enabled:=enab;
        ELSE                                                      (* use before -C set both *)
          FOR ch:=0 TO HIGH(chan) DO chan[ch].mp3h.enabled:=enab END;
        END;

      ELSIF h[1]="3" THEN
        IF chanset THEN                                           (* set only 1 chan *)
          chan[channel].c34a.enabled:=enab;
        ELSE                                                      (* use before -C set both *)
          FOR ch:=0 TO HIGH(chan) DO chan[ch].c34a.enabled:=enab END;
        END;

      ELSIF h[1]="9" THEN
        IF chanset THEN                                           (* set only 1 chan *)
          chan[channel].r92.enabled:=enab;
        ELSE                                                      (* use before -C set both *)
          FOR ch:=0 TO HIGH(chan) DO chan[ch].r92.enabled:=enab END;
        END;

      ELSIF h[1]="4" THEN
        IF chanset THEN                                           (* set only 1 chan *)
          chan[channel].r41.enabled:=enab;
        ELSE                                                      (* use before -C set both *)
          FOR ch:=0 TO HIGH(chan) DO chan[ch].r41.enabled:=enab END;
        END;

      ELSIF h[1]="6" THEN
        IF chanset THEN                                           (* set only 1 chan *)
          chan[channel].dfm6a.enabled:=enab;
        ELSE                                                      (* use before -C set both *)
          FOR ch:=0 TO HIGH(chan) DO chan[ch].dfm6a.enabled:=enab END;
        END;

      ELSIF h[1]="1" THEN
        IF chanset THEN                                           (* set only 1 chan *)
          chan[channel].m10.enabled:=enab;
        ELSE                                                      (* use before -C set both *)
          FOR ch:=0 TO HIGH(chan) DO chan[ch].m10.enabled:=enab END;
        END;

      ELSIF h[1]="8" THEN
        IF chanset THEN                                           (* set only 1 chan *)
          chan[channel].imeta.enabled:=enab;
        ELSE                                                      (* use before -C set both *)
          FOR ch:=0 TO HIGH(chan) DO chan[ch].imeta.enabled:=enab END;
        END;

      ELSIF h[1]="N" THEN
        NextArg(h);
        IF NOT StrToCard(h, dfmnametyp) THEN err:=TRUE END;
        INC(dfmnametyp, 512);

      ELSIF h[1]="n" THEN
        NextArg(h);
        IF NOT StrToCard(h, dfmnametyp) THEN err:=TRUE END;
        INC(dfmnametyp, 256);

      ELSIF h[1]="c" THEN
        NextArg(h);
        IF NOT StrToCard(h, cnum) THEN err:=TRUE END;
        IF cnum>=HIGH(chan) THEN Error("maxchannels 0..max") END;
        cfgchannels:=cnum;
        IF cfgchannels>0 THEN maxchannels:=cfgchannels-1 END;

      ELSIF h[1]="C" THEN
        NextArg(h);
        IF NOT StrToCard(h, cnum) THEN err:=TRUE END;
        IF cnum>1 THEN Error("channel 0 to max") END;
        channel:=cnum;
        chanset:=TRUE;

      ELSIF h[1]="D" THEN
        NextArg(h1); debfd:=OpenWrite(h1);

      ELSIF h[1]="e" THEN
        NextArg(h);
        IF NOT StrToInt(h, inum) THEN err:=TRUE END;
        IF ABS(inum)>999 THEN Error("equalizer -999..999") END;
        chan[channel].configequalizer:=inum;

      ELSIF h[1]="f" THEN
        NextArg(h);
        IF NOT StrToCard(h, cnum) THEN err:=TRUE END;
        IF (cnum<8000) OR (cnum>96000) THEN Error("sampelrate 8000..96000") END;
        adcrate:=cnum; 

      ELSIF h[1]="F" THEN
        NextArg(h);
        IF NOT StrToCard(h, cnum) THEN err:=TRUE END;
        chan[channel].c34a.configafskmid:=cnum;

      ELSIF h[1]="G" THEN
        NextArg(h);
        IF NOT StrToCard(h, dfmidchgthreshold) THEN err:=TRUE END;

      ELSIF h[1]="g" THEN
        NextArg(h);
        IF NOT StrToCard(h, dfmidoldthreshold) THEN err:=TRUE END;

      ELSIF h[1]="S" THEN
        NextArg(h);
        IF NOT StrToCard(h, dfmidthreshold) THEN err:=TRUE END;

      ELSIF h[1]="W" THEN
        NextArg(h);
        IF NOT StrToCard(h, savelevel) THEN err:=TRUE END;

      ELSIF h[1]="l" THEN
        NextArg(h);
        IF NOT StrToCard(h, cnum) THEN err:=TRUE END;
        IF (cnum>=16) & (cnum<=ADCBUFLEN) THEN adcbuflen:=cnum 
        ELSE Error("sound buffer out of range") END;

      ELSIF h[1]="o" THEN NextArg(soundfn);

      ELSIF h[1]="L" THEN NextArg(rxlabel);

      ELSIF h[1]="I" THEN
        NextArg(mycall);
        IF NOT packcall(mycall, myc, mys) THEN Error("-I illegall Callsign + ssid") END;
        IF chanset THEN                                           (* set only 1 chan *) 
          WITH chan[channel] DO mycallc:=myc; myssid:=mys END;
        ELSE                                                      (* use before -C set both *)
          FOR ch:=0 TO HIGH(chan) DO chan[ch].mycallc:=myc; chan[ch].myssid:=mys; END;
        END;

      ELSIF h[1]="u" THEN 
        NextArg(h);
        ALLOCATE(utx, SIZE(utx^));
        IF utx=NIL THEN Error("udp socket out of memory") END;

        utx^.udpfd:=GetIp(h, utx^.ip, utx^.destport);
        IF utx^.udpfd<0 THEN Error("cannot open udp socket") END;

        IF chanset THEN                                           (* set only 1 chan *)
          utx^.next:=chan[channel].udptx;
          chan[channel].udptx:=utx;
        ELSE                                                      (* use before -C set both *)
          FOR ch:=0 TO HIGH(chan) DO utx^.next:=chan[ch].udptx; chan[ch].udptx:=utx END;
        END;

      ELSIF h[1]="M" THEN 
        NextArg(h);
        ALLOCATE(utx, SIZE(utx^));
        IF utx=NIL THEN Error("udp socket out of memory") END;

        utx^.udpfd:=GetIp(h, utx^.ip, utx^.destport);
        IF utx^.udpfd<0 THEN Error("cannot open udp socket") END;

        utx^.next:=monitorudp;
        monitorudp:=utx;

      ELSIF h[1]="v" THEN verb:=TRUE;

      ELSIF h[1]="s" THEN nosendsdr:=TRUE;

      ELSIF h[1]="V" THEN verb:=TRUE; verb2:=TRUE

      ELSIF h[1]="O" THEN dfmoldname:=TRUE;

      ELSIF h[1]="h" THEN
        WrStrLn("Mono/Stereo up to 64 Channel RS92, RS41, C34, C50, DFM, IMET, M10, M20, MRZ, MEISEI Sonde Demodulator");
        WrStrLn("to raw Frames sent via UDP to 'sondemod' decoder or watch with -v V:"+VERSION);
        WrStrLn("more demodulators may send to same 'sondemod'");
        WrStrLn("Stereo used for 2 Rx for 2 Sondes or 1 Sonde with Antenna-Diversity");
        WrStrLn(" Switch off not needed decoders to save CPU");
        WrStrLn(" -1             disable M10,M20 decoding (use -C before to select a channel)");
        WrStrLn(" -2             disable MRZ,Meisei decoding (use -C before to select a channel)");
        WrStrLn(" -3             disable SRSC34/50 decoding (use -C before to select a channel)");
        WrStrLn(" -4             disable RS41 decoding (use -C before to select a channel)");
        WrStrLn(" -6             disable DFM decoding (use -C before to select a channel)");
        WrStrLn(" -8             disable IMET decoding (use -C before to select a channel)");
        WrStrLn(" -9             disable RS92 decoding (use -C before to select a channel)");
        WrStrLn(' +<typenum>     exclude from sleep if -W <s> set eg. "+4" no sleep RS41');
        WrStrLn(" -a             abort on sounddevice error else retry to open (USB audio, pipe)");
        WrStrLn(" -c <num>       maxchannels, 0 for automatic channel number recognition from sdrtst");
        WrStrLn(" -C <num>       channel parameters follow (repeat for each channel)");
        WrStrLn(" -D <filename>  write raw soundcard input data to file or pipe");
        WrStrLn("                for debug or chaining demodulators (equalizer diversity)");
        WrStrLn(" -e <num>       demod equalizer (0) 100=6db/oct highpass (-999..999)");
        WrStrLn("                -C <n> before -e sets channel number");
        WrStrLn(" -f <num>       adcrate (22050) (8000..96000)");
        WrStrLn(" -g <minutes>   DFMxx (with no serial number) substitute name stability check before tx (1)");
        WrStrLn('                default set to 3 on automatic serial number search "-n 0"');
        WrStrLn(" -G <minutes>   no tx if DFMxx substitute Name changes (3)");
        WrStrLn(" -h             help");
        WrStrLn(" -I <call>      mycall + ssid (use -C before to select 1 channel) else sondemod sets call");
        WrStrLn(" -l <num>       sound buffer length (256)");
        WrStrLn(" -L <name>      Label of device sent to sondemod, max 4 char");
        WrStrLn(" -M <x.x.x.x:destport> Send (human readable) UDP info about decoded data to Scanner");
        WrStrLn("                  (or netcat) to weed out birdies, maybe repeated for more destinations");
        WrStrLn(" -N <num>       1..255 generate DFM-ID from serial no. (see -V) (off)");
        WrStrLn('                num is start byte of frame with serial no. in decimal "AC00070" -N 172');
        WrStrLn('                0 automatic search serial number (default), increase -S for more reliability');
        WrStrLn(' -n <num>       same as -N but send substitute name if no serial number found in "-g" min');
        WrStrLn(' -O             DFM send "DF6..." with hex number else "D..." with decimal number');
        WrStrLn(" -o <filename>  oss devicename (/dev/dsp) or raw/wav audio file or pipe /dev/stdin");
        WrStrLn(" -s             disable sending sdr-data (freq/afc/rssi/label) to (old version) sondemod");
        WrStrLn(" -S <retries>   check DFM serial number for stability before fixing name (1)");
        WrStrLn("                on automatic search, minimum and default is 2");
        WrStrLn(" -u <x.x.x.x:destport> send rx data in udp (to sondemod), -C <n> before sets");
        WrStrLn("                channel number, maybe repeated for more destinations");
        WrStrLn(" -V             very verbous, with some hex dumps");
        WrStrLn(" -v             verbous, (frames with Name looks ok)");
        WrStrLn(" -W <s>         cyclic sleep <seconds> inactive demodulators to save CPU");
        WrStrLn("                  wakes 1..2s (dep. on type) and stay long awake if found fitting pattern");
        WrStrLn("                  do not use in frequency-hopping environment");
        WrStrLn("example: sondeudp -f 16000 -o /dev/dsp -c 2 -C 0 -e 50 -u 127.0.0.1:4000 -v");

        HALT

      ELSE err:=TRUE END;
    ELSE err:=TRUE END;
    IF err THEN EXIT END;
  END;
  IF err THEN WrStr(">"); WrStr(h); WrStrLn("< use -h"); HALT END;

  IF adcbuflen*(maxchannels+1)>ADCBUFLEN THEN adcbuflen:=ADCBUFLEN DIV (maxchannels+1) END; 
  IF (dfmnametyp=256) & (dfmidoldthreshold<2) THEN dfmidoldthreshold:=2 END;
  IF (dfmnametyp MOD 256=0) & (dfmidthreshold<2) THEN dfmidthreshold:=2 END; 
  IF dfmidthreshold=0 THEN dfmidthreshold:=1 END;
  Config;
  OpenSound;
END Parms;


PROCEDURE sendudp(data:ARRAY OF CHAR; len:INTEGER; ip:IPNUM; destport:UDPPORT; udpfd:INTEGER);
VAR i:INTEGER;
BEGIN
  i:=udp.udpsend(udpfd, data, len, destport, ip); 
END sendudp;

PROCEDURE WrChName(n:CARDINAL);
BEGIN
(*
  WrStr(CHR(ASH(n,-24)));
  WrStr(CHR(ASH(n,-16) MOD 256));
  WrStr(CHR(ASH(n,-8) MOD 256));
  WrStr(CHR(n MOD 256));
*)
  WrInt(n, 1)
END WrChName;

PROCEDURE appendsdr(c:CARDINAL);
VAR i:CARDINAL;
    v,w:INTEGER;
BEGIN
  IF chan[c].waterok THEN
    i:=0;
    WHILE (i<=HIGH(chan[0].waterdata)) & (chan[c].waterdata[i].cmd<>0C) DO
      WITH chan[c].waterdata[i] DO
        IF cmd=cFREQ THEN WrStr(" "); WrFixed(FLOAT(dat)*0.00001,3,1);
        ELSIF cmd=cAFC THEN
          v:=CAST(INT16, CAST(SET32, dat)*SET32{0..15});
          w:=CAST(INT16, SHIFT(CAST(SET32, dat), -16));
          IF w<>0 THEN
            WrStr("(");
            IF v>=0 THEN WrStr("+") END; 
            WrInt(v, 1); WrStr("/"); WrInt(w, 1);
            WrStr(")");
          END;
          WrStr(" ");
        ELSIF cmd=cRAPPORT THEN WrFixed(FLOAT(dat)*0.1, 1, 1); WrStr("dB");
--      ELSIF cmd=cCHNAME THEN WrStr(" $"); WrChName(dat); WrStr(" ");
        END;
      END;
      INC(i);
    END;
    chan[c].waterok:=FALSE;
  END;
END appendsdr;

PROCEDURE sdrparm(VAR b:ARRAY OF CHAR; VAR len:CARDINAL; ch:INTEGER);
CONST SDRBLEN=3*5+4;
      WATERTIME=2;                            (* seconds send unupdated waterdata *)

VAR p, i, j:CARDINAL;
    t:TIME;
BEGIN
  IF NOT nosendsdr THEN
    p:=len;
    t:=time();
    IF (chan[ch].watersend<=t) & (chan[ch].watersend+WATERTIME>=t) & (HIGH(b)>len+SDRBLEN) THEN
      i:=0;
      WHILE (i<=HIGH(chan[0].waterdata)) & (chan[ch].waterdata[i].cmd<>0C) DO
        WITH chan[ch].waterdata[i] DO
          IF (cmd=cFREQ) OR (cmd=cAFC) OR (cmd=cRAPPORT) THEN
            b[p]:=cmd; INC(p);
            b[p]:=CHR(dat DIV 1000000H); INC(p);
            b[p]:=CHR(dat DIV 10000H MOD 256); INC(p);
            b[p]:=CHR(dat DIV 100H MOD 256); INC(p);
            b[p]:=CHR(dat MOD 256); INC(p);
          END;
        END;
        INC(i);
      END;
    END;
    IF rxlabel[0]<>0C THEN
      b[p]:="n"; INC(p);
      b[p]:=rxlabel[0]; INC(p);    
      b[p]:=rxlabel[1]; INC(p);    
      b[p]:=rxlabel[2]; INC(p);    
      b[p]:=rxlabel[3]; INC(p);    
    END;
    b[p]:=CHR(len DIV 100H MOD 256); INC(p);           (* append original sonde data len *)
    b[p]:=CHR(len MOD 256); INC(p);
    b[p]:=CHR(255-len DIV 100H MOD 256); INC(p);       (* safety copy *)
    b[p]:=CHR(255-len MOD 256); INC(p);
    len:=p;
  END;
END sdrparm;


PROCEDURE WrdB(volt:INTEGER);
BEGIN
  IF volt>0 THEN WrFixed(log(LFLOAT(volt))*8.685889638-(96.4), 1,6); WrStr("dB"); END;
END WrdB;

PROCEDURE WrQ(lev, noise:REAL);
BEGIN
  IF lev>0.0 THEN
    noise:=noise*200.0/lev;
    IF noise>100.0 THEN noise:=100.0 ELSIF noise<=0.0 THEN noise:=0.0 END;
    WrInt(100-VAL(INTEGER, noise), 3); WrStr("%");
  END;
END WrQ;

PROCEDURE WrQuali(q:REAL);
BEGIN
  IF q>0.0 THEN
    q:=100.5-q*100.0;
    IF q<0.0 THEN q:=0.0 END;
    WrStr(" q:"); WrInt(realint(q), 2);
  END;
END WrQuali;

PROCEDURE Wrtune(volt, max:INTEGER);
VAR u:INTEGER;
BEGIN
  IF (max>0) & (max>ABS(volt)) THEN
    u:=volt*50 DIV max;
    IF ABS(u)>0 THEN WrStr(" f:"); WrInt(u, 2) ELSE WrStr("     ") END;
  END;
END Wrtune;

PROCEDURE wrtime(t:CARDINAL);
VAR s:ARRAY[0..30] OF CHAR;
BEGIN
  TimeToStr(t, s); WrStr(s);
END wrtime;

PROCEDURE wrdate(t:CARDINAL);
VAR s:ARRAY[0..30] OF CHAR;
BEGIN
  DateToStr(t, s); WrStr(s);
END wrdate;


PROCEDURE noiselevel(bitlev, noise:REAL):REAL;             (* 0.0 perfect, ~0.25 noise only*)
BEGIN
  IF bitlev=0.0 THEN RETURN 0.0
  ELSE RETURN noise/bitlev END;
END noiselevel;


PROCEDURE WrChan(c:INTEGER);
BEGIN
  IF maxchannels>0 THEN
    WrInt(c+1, 1); WrStr(":");
  END;
END WrChan;

PROCEDURE Fir(in, sub, step:CARDINAL; VAR fir, firtab:ARRAY OF REAL):REAL;
VAR s:REAL;
    i:CARDINAL;
BEGIN
  s:=0.0;
  i:=sub;
  REPEAT
    s:=s + fir[in]*firtab[i];
    INC(in);
    IF in>HIGH(fir) THEN in:=0 END;
    INC(i, step);
  UNTIL i>HIGH(firtab);
  RETURN s
END Fir;


PROCEDURE alludp(utx:pUDPTX; len:CARDINAL; buf:ARRAY OF CHAR);
BEGIN
  WHILE utx<>NIL DO
    IF utx^.udpfd>=0 THEN sendudp(buf, len, utx^.ip, utx^.destport, utx^.udpfd) END;
    utx:=utx^.next;
  END;
END alludp;


PROCEDURE getfreq(ch:CARDINAL):CARDINAL;        (* in 10hz *)
VAR i,f:CARDINAL;
BEGIN
  i:=0;
  f:=0;
  WHILE (i<=HIGH(chan[0].waterdata)) & (chan[ch].waterdata[i].cmd<>0C) DO
    WITH chan[ch].waterdata[i] DO
      IF cmd=cFREQ THEN INC(f, dat);
      ELSIF cmd=cAFC THEN INC(f, CAST(INTEGER, CAST(INT16, dat MOD 10000H))*100) END;
    END;
    INC(i);
  END;
  RETURN f
END getfreq;


PROCEDURE monitor(ch:CARDINAL; typ-, id-:ARRAY OF CHAR);
VAR u:pUDPTX;
    t:TIME;
    hz10:CARDINAL;
    s,h:ARRAY[0..200] OF CHAR;
BEGIN
  IF monitorudp<>NIL THEN
    hz10:=getfreq(ch);
    IF hz10=0 THEN hz10:=ch END;               (* use channel number if no sdr frequency *)
--  IF hz10<>0 THEN
      t:=time();
      IF chan[ch].lastmon+MONTIME<t THEN
        chan[ch].lastmon:=t;
        s:="RX";
        CardToStr(hz10, 1, h); Append(s,h);
        Append(s,","); Append(s, typ);
        IF id[0]<>0C THEN Append(s,","); Append(s, id) END;
        Append(s, 12C);
        u:=monitorudp;
        REPEAT
          IF u^.udpfd>=0 THEN sendudp(s, Length(s), u^.ip, u^.destport, u^.udpfd) END;
          u:=u^.next;
        UNTIL u=NIL;
      END;
--  END;
  END;
END monitor;

PROCEDURE cardmsb(b-:ARRAY OF CHAR; pos, len:CARDINAL):CARDINAL;
VAR i, n:CARDINAL;
BEGIN
  n:=0;
  FOR i:=len-1 TO 0 BY -1 DO n:=n*256 + ORD(b[pos+i]) END;
  RETURN n
END cardmsb;

PROCEDURE atang2(x, y:LONGREAL):LONGREAL;
VAR w:LONGREAL;
BEGIN
  IF ABS(x)>ABS(y) THEN
    w:=atan(y/x);
    IF x<0.0 THEN
      IF y>0.0 THEN w:=pi+w ELSE w:=w-pi END;
    END;
  ELSIF y<>0.0 THEN
    w:=(pi*0.5-atan(x/y));
    IF y<0.0 THEN w:=w-pi END;
  ELSE w:=0.0 END;
  RETURN w
END atang2;

PROCEDURE wgs84r(x,y,z:LONGREAL; VAR lat, long, heig:LONGREAL);
CONST EARTHA=6378137.0;
      EARTHB=6356752.31424518;
      E2=0.00669437999014132;
      EARTHAB=(EARTHA*EARTHA - EARTHB*EARTHB) / (EARTHB*EARTHB) * EARTHB;
VAR h, xh, rh, t, st, ct, sl:LONGREAL;
BEGIN
  h:=x*x + y*y;
  IF h>0.0 THEN
    rh:=sqrt(h);
    xh:=x+rh;
    long:=atang2(xh, y)*2.0;
    IF long>pi THEN long:=long-pi*2 END;
    t:=atan(z*(EARTHA/EARTHB)/rh);
    st:=sin(t);
    ct:=cos(t);
    lat:=atan((z + EARTHAB*st*st*st)/(rh - (E2*EARTHA)*ct*ct*ct));
    sl:=sin(lat);
    heig:=rh/cos(lat) - (EARTHA/sqrt(1 - E2*sl*sl));
  ELSE lat:=0.0; long:=0.0; heig:=0.0 END; 
--  lat:=atan(z/(rh*(1.0 - E2)));
--  heig:=sqrt(h + z*z) - EARTHA;

END wgs84r;

PROCEDURE speeddir(lat, long, vx,vy,vz:LONGREAL; VAR kmh, dir, clb:LONGREAL);
VAR vn,ve,vu,sinlat,coslat,sinlong,coslong:LONGREAL;
BEGIN
  sinlat:=sin(lat);
  coslat:=cos(lat);
  sinlong:=sin(long);
  coslong:=cos(long);
  vn:=-vx*sinlat*coslong - vy*sinlat*sinlong + vz*coslat;
  ve:=-vx*sinlong + vy*coslong;
  clb:= vx*coslat*coslong + vy*coslat*sinlong + vz*sinlat;
  dir:=atang2(vn, ve)/RAD;
  IF dir<0.0 THEN dir:=360.0+dir END;
  kmh:=(sqrt(vn*vn + ve*ve)*3.6);
END speeddir;

PROCEDURE setactiv(VAR savecnt:INTEGER;  t:INTEGER);
BEGIN
  IF savecnt<0 THEN savecnt:=0 END;
  IF savecnt<MAXACTIVE THEN INC(savecnt, t) END;
END setactiv;


PROCEDURE reedsolomon92(VAR buf:ARRAY OF CHAR):INTEGER;
VAR i:CARDINAL;
    res:INTEGER;
    b:ARRAY[0..255] OF CHAR;
    eraspos:ARRAY[0..23] OF CARDINAL;
BEGIN
  FOR i:=0 TO HIGH(b) DO b[i]:=0C END;
  FOR i:=0 TO 240-6-24-1 DO b[(255-24-1)-i]:=buf[i+6] END;
  FOR i:=0 TO 24-1 DO b[(255-1)-i]:=buf[i+(240-24)] END;
  res:=decodersc(b, eraspos, 0);
  IF (res>0) & (res<=12) THEN
    FOR i:=0 TO 240-6-24-1 DO buf[i+6]:=b[(255-24-1)-i] END;
    FOR i:=0 TO 24-1 DO buf[i+(240-24)]:=b[(255-1)-i] END;
  END;
  RETURN res
END reedsolomon92;


PROCEDURE crcrs(frame-:ARRAY OF CHAR; from,to:INTEGER):BOOLEAN;
VAR crc:SET16;
    i:INTEGER;
BEGIN
  crc:=SET16{0..15};
  FOR i:=from TO to-3 DO
    crc:=SHIFT(crc, -8)/CRCTAB[CAST(CARDINAL, (crc/(CAST(SET16,frame[i])))*SET16{0..7})];
  END;
  RETURN (frame[to-1]=CAST(CHAR, crc)) & (frame[to-2]=CAST(CHAR, SHIFT(crc,-8)))
END crcrs;


PROCEDURE decodeframe92(m:CARDINAL);
CONST
  POLYNOM=SET16{0,5,12};

VAR j,p, len, ic, flen:CARDINAL;
    corr:INTEGER;
    id:ARRAY[0..7] OF CHAR;
BEGIN
  corr:=reedsolomon92(chan[m].r92.rxbuf);
  WITH chan[m] DO
    IF mycallc>0 THEN
      chan[m].r92.rxbuf[0]:=CHR(mycallc DIV (256*256*256));
      chan[m].r92.rxbuf[1]:=CHR(mycallc DIV (256*256) MOD 256);
      chan[m].r92.rxbuf[2]:=CHR(mycallc DIV (256) MOD 256);
      chan[m].r92.rxbuf[3]:=CHR(mycallc MOD 256);
      chan[m].r92.rxbuf[4]:=myssid;
    END; 
    flen:=FLENR92;
    sdrparm(chan[m].r92.rxbuf, flen, m);
    alludp(udptx, flen, chan[m].r92.rxbuf);
  END;

  id[0]:=0C;
  p:=6;
  IF chan[m].r92.rxbuf[p]=CALIBFRAME THEN
    INC(p);
    len:=ORD(chan[m].r92.rxbuf[p])*2+2;      (* +crc *)
    INC(p);
    IF verb THEN
      WrChan(m);
      WrStr("R92 ");
    END;
    IF (p+len>FLENR92) OR NOT crcrs(chan[m].r92.rxbuf, p, p+len) THEN
      IF verb THEN WrStr("----  crc err ") END;
    ELSE
      j:=0;
      WHILE (chan[m].r92.rxbuf[p+j+4]>=" ") & (j<=HIGH(id)) DO id[j]:=chan[m].r92.rxbuf[p+j+4]; INC(j); END;
--      j:=4;
--      WHILE chan[m].r92.rxbuf[p+j]>=" " DO WrStr(chan[m].r92.rxbuf[p+j]); INC(j); END;
      IF verb THEN 
        WrStr(id); WrStr(" ");
        WrInt(ORD(chan[m].r92.rxbuf[p])+ORD(chan[m].r92.rxbuf[p+1])*256, 4);
      END;
      setactiv(chan[m].r92.savecnt, 60);
    END;
--      IF m>0 THEN WrStr("             ") END;
    IF verb THEN
      WrdB(chan[m].admax-chan[m].admin);
      WrQ(chan[m].r92.bitlev, chan[m].r92.noise);
      IF corr<0 THEN WrStr(" -R");
      ELSIF (corr>0) & (corr<=12) THEN WrStr(" +"); WrInt(corr, 1); WrStr("R") END;
--      Wrtune(chan[m].admax+chan[m].admin, chan[m].admax-chan[m].admin);
      appendsdr(m);
      WrStrLn("");    
    END;
    monitor(m, "RS92", id);

  END;
END decodeframe92;

PROCEDURE latlong(val:CARDINAL; c50:BOOLEAN):LONGREAL;
VAR hr,hf:LONGREAL;
BEGIN
  hr:=LFLOAT(val MOD 80000000H);
  IF c50 THEN hr:=hr/10000000.0 ELSE hr:=hr/1000000.0 END;
  hf:=LFLOAT(TRUNC(hr));
  hr:=hf + (hr-hf)/0.6;
  IF val>=80000000H THEN hr:=-hr END;
  RETURN hr
END latlong;

PROCEDURE hex(n:CARDINAL):CHAR;
BEGIN
  n:=n MOD 16;
  IF n<10 THEN RETURN CHR(n+ORD("0")) ELSE RETURN CHR(n+(ORD("A")-10)) END;
END hex;


-------------------------------- RS41

PROCEDURE sendrs41(m:CARDINAL);
VAR flen:CARDINAL;
BEGIN
  WITH chan[m] DO
    IF mycallc>0 THEN
      r41.rxbuf[0]:=CHR(mycallc DIV (256*256*256));
      r41.rxbuf[1]:=CHR(mycallc DIV (256*256) MOD 256);
      r41.rxbuf[2]:=CHR(mycallc DIV (256) MOD 256);
      r41.rxbuf[3]:=CHR(mycallc MOD 256);
      r41.rxbuf[4]:=myssid;
      r41.rxbuf[5]:=0C;
      r41.rxbuf[6]:=0C;
    END; 
    flen:=FLENRS41;
    sdrparm(r41.rxbuf, flen, m);
    alludp(udptx, flen, r41.rxbuf);
  END;

END sendrs41;


PROCEDURE getint32(frame-:ARRAY OF CHAR; p:CARDINAL):INTEGER;
VAR n:CARDINAL;
    i:CARDINAL;
BEGIN
  n:=0;
  FOR i:=3 TO 0 BY -1 DO n:=n*256+ORD(frame[p+i]) END;
  RETURN n 
END getint32;

PROCEDURE getcard16(frame-:ARRAY OF CHAR; p:CARDINAL):CARDINAL;
BEGIN
  RETURN ORD(frame[p])+256*ORD(frame[p+1]);
END getcard16;

PROCEDURE getint16(frame-:ARRAY OF CHAR; p:CARDINAL):INTEGER;
VAR n:CARDINAL;
BEGIN
  n:=ORD(frame[p])+256*ORD(frame[p+1]);
  IF n>=32768 THEN RETURN n-65536 END;

  RETURN n
END getint16;

PROCEDURE posrs41(b-:ARRAY OF CHAR; p:CARDINAL);
VAR i:CARDINAL;
    x, y, z, lat, long, heig, vx, vy, vz, kmh, clb, dir:LONGREAL;
BEGIN
  x:=VAL(LONGREAL, getint32(b, p))*0.01;
  y:=VAL(LONGREAL, getint32(b, p+4))*0.01;
  z:=VAL(LONGREAL, getint32(b, p+8))*0.01;
  wgs84r(x,y,z, lat, long, heig);
  WrStr(" "); WrFixed(lat/RAD, 5,1);
  WrStr(" "); WrFixed(long/RAD, 5,1);
  IF (heig<100000.0) & (heig>-100000.0) THEN
    WrStr(" "); WrInt(VAL(INTEGER, heig), 1); WrStr("m");
  END;
--speed
  vx:=VAL(LONGREAL, getint16(b, p+12))*0.01;
  vy:=VAL(LONGREAL, getint16(b, p+14))*0.01;
  vz:=VAL(LONGREAL, getint16(b, p+16))*0.01;
  speeddir(lat, long, vx,vy,vz, kmh, dir, clb);
  WrStr(" "); WrFixed(kmh, 1,1); WrStr("km/h ");
  WrInt(VAL(INTEGER, dir), 1); WrStr("deg ");
  WrFixed(clb, 1,1); WrStr("m/s ");
--  WrFixed(FLOAT(ORD(b[p+20]))*0.1, 1, 1); WrStr("dop");
END posrs41;


PROCEDURE rs41date(f-:ARRAY OF CHAR; p:CARDINAL):TIME;
VAR s:ARRAY[0..20] OF CHAR;
    n:CARDINAL;
BEGIN
  s:="....-..-.. 00:00:00";
  n:=ORD(f[p])+256*ORD(f[p+1]);
  s[0]:=CHR(n DIV 1000+ORD("0"));
  s[1]:=CHR(n DIV 100 MOD 10+ORD("0"));
  s[2]:=CHR(n DIV 10 MOD 10+ORD("0"));
  s[3]:=CHR(n MOD 10+ORD("0"));
  n:=ORD(f[p+2]);
  s[5]:=CHR(n DIV 10+ORD("0"));
  s[6]:=CHR(n MOD 10+ORD("0"));
  n:=ORD(f[p+3]);
  s[8]:=CHR(n DIV 10+ORD("0"));
  s[9]:=CHR(n MOD 10+ORD("0"));
  IF StrToTime(s, n) THEN
    INC(n, ORD(f[p+4])*3600);
    INC(n, ORD(f[p+5])*60);
    INC(n, ORD(f[p+6]));
  ELSE n:=0 END;
  RETURN n
END rs41date;


PROCEDURE reedsolomon41(VAR buf:ARRAY OF CHAR; len2:CARDINAL):INTEGER;
VAR i:CARDINAL;
    res, res1:INTEGER;
--tb1,
    b,b1:ARRAY[0..255] OF CHAR;
    eraspos:ARRAY[0..23] OF CARDINAL;
BEGIN
  FOR i:=0 TO HIGH(b) DO b[i]:=0C; b1[i]:=0C END;
  FOR i:=0 TO len2 DO
    b [(255-24-1)-i]:=buf[i*2+56];
    b1[(255-24-1)-i]:=buf[i*2+57];
  END;
  FOR i:=0 TO 24-1 DO
    b [(255-1)-i]:=buf[i+8];
    b1[(255-1)-i]:=buf[i+(8+24)];
  END;
--tb1:=b;
  res :=decodersc(b,  eraspos, 0);
--FOR i:=0 TO HIGH(b) DO
--IF tb1[i]<>b[i] THEN WrHex(ORD(tb1[i]),4);WrHex(ORD(b[i]),4);WrInt(i, 4); WrStr("=pos "); END;
--END;
--tb1:=b1;
  res1:=decodersc(b1, eraspos, 0);
--FOR i:=0 TO HIGH(b) DO
--IF tb1[i]<>b1[i] THEN WrHex(ORD(tb1[i]),4);WrHex(ORD(b1[i]),4);WrInt(i, 4); WrStr("=pos1 "); END;
--END;
  IF (res>0) & (res<=12) THEN
    FOR i:=0 TO len2 DO buf[i*2+56]:=b[(255-24-1)-i] END;
    FOR i:=0 TO 24-1 DO buf[i+8]:=b[(255-1)-i] END;
  END;
  IF (res1>0) & (res1<=12) THEN
    FOR i:=0 TO len2 DO buf[i*2+57]:=b1[(255-24-1)-i] END;
    FOR i:=0 TO 24-1 DO buf[i+(8+24)]:=b1[(255-1)-i] END;
  END;
  IF (res<0) OR (res1<0) THEN RETURN -1 ELSE RETURN res+res1 END
END reedsolomon41;

PROCEDURE decode41(m:CARDINAL);
CONST POLYNOM=SET16{0,5,12};
      POWERTAB=ARRAY OF CARD8 {1,2,5,8,11,14,17,20};

VAR i,j,p,len,ic,nameok, posok, try, date:CARDINAL;
    typ, ch    :CHAR;
    crc        :SET16;
    allok,
    newvers,
    encr       :BOOLEAN;
    corr, repl :INTEGER;
    satc,
    aux        :CARDINAL;
    s          :ARRAY[0..23] OF CHAR;
    ha, monid  :ARRAY[0..15] OF CHAR;
    id         :ARRAY[0..7] OF CHAR;
BEGIN
  WITH chan[m].r41 DO
    try:=0;
    REPEAT
      allok:=TRUE;
      nameok:=0;
      posok:=0; 
      corr:=0;
      repl:=0; 
      date:=0;
      encr:=FALSE;
      aux:=0;
      satc:=MAX(CARDINAL);
      newvers:=FALSE;
      IF try>0 THEN

        IF try>1 THEN
          FOR i:=0 TO HIGH(rxbuf) DO
            IF fixcnt[i]>=10 THEN                              (* replace stable bytes *)
              rxbuf[i]:=fixbytes[i];
              INC(repl);
            END; 
          END;
        END;

        corr:=reedsolomon41(rxbuf, 131);                       (* try short frame *)
        IF corr<0 THEN corr:=reedsolomon41(rxbuf, 230) END;    (* may be long frame *)
      END;
      p:=039H;
      LOOP 
        IF p+4>=HIGH(rxbuf) THEN EXIT END;

        typ:=rxbuf[p];
        INC(p);
        len:=ORD(rxbuf[p])+2;
        INC(p);
        IF p+len>=HIGH(rxbuf) THEN EXIT END;
(*
WrStrLn("");
FOR i:=0 TO len+1 DO WrHex(ORD(rxbuf[p+i-2]),3) ; IF i MOD 16=15 THEN WrStrLn(""); END; END;
WrStrLn("");
*)

        IF NOT crcrs(rxbuf, p, p+len) THEN                                (* crc error *)
          allok:=FALSE;
          EXIT

        ELSE
          IF verb2 THEN
            WrStrLn("");
            WrStrLn("");
            WrStr("crc ok, start ID length data... crc [");
            WrHex((p-2) DIV 256, 0); WrHex(p-2, 3);
            WrHex(ORD(rxbuf[p-2]), 3);
            WrHex(ORD(rxbuf[p-1]), 0);
            WrStrLn("]");
            FOR i:=0 TO len-1 DO
              ch:=rxbuf[p+i];
              WrHex(ORD(ch), 3);
              IF (ch>=" ") & (ch<=CHR(126)) THEN ha[i MOD 16]:=ch ELSE ha[i MOD 16]:="." END;
              IF i MOD 16<>15 THEN ha[(i+1) MOD 16]:=0C END; 
              IF (i=len-1) OR (i MOD 16=15) THEN WrStrLn(ha) END;
            END;
            WrStrLn("");
          END;

          FOR i:=p-2 TO p+len-1 DO                           (* update fixbyte statistics *)
            IF fixbytes[i]=rxbuf[i] THEN
              IF fixcnt[i]<255 THEN INC(fixcnt[i]) END;
            ELSE
              fixbytes[i]:=rxbuf[i];
              fixcnt[i]:=0;
            END;
          END; 

          IF typ=CHR(79H) THEN                               (* ID with correct crc *)
            nameok:=p;
            FOR i:=0 TO 7 DO
              id[i]:=rxbuf[nameok+2+i];
              IF (id[i]<=" ") OR (id[i]>=CHR(127)) THEN id[i]:="." END;
            END;
            setactiv(savecnt, 60);

--        ELSIF typ=CHR(7AH) THEN
--             WrStrLn("7A ptu frame");

          ELSIF typ=CHR(7CH) THEN
            date:=VAL(CARDINAL, getint32(rxbuf, p+2)) DIV 1000 + ((DAYSEC-GPSTIMECORR) MOD DAYSEC)
                  + getcard16(rxbuf, p)*(7*3600*24) + 3656*DAYSEC;
(*           
            WrStrLn("");
            FOR i:=0 TO 11 DO
              WrInt(ORD(rxbuf[p+6+i*2]), 1);                     (* sat n *)
              WrStr(":");
              WrFixed(FLOAT(ORD(rxbuf[p+7+i*2]))*0.2, 1, 1);     (* signal ? *)
              WrStr(" ");
            END;
*)
--        WrStrLn("7C frame");
--WrInt(getint32(rxbuf, p+2) DIV 1000 MOD 86400 , 10); WrStr("=gpstime ");

--        ELSIF typ=CHR(7DH) THEN
--             WrStrLn("7D gps raw");

          ELSIF typ=CHR(7BH) THEN
            posok:=p; 
            satc:=ORD(rxbuf[p+18]);

          ELSIF typ=CHR(82H) THEN
            posok:=p; 
            date:=rs41date(rxbuf,p+18) + ((DAYSEC-GPSTIMECORR) MOD DAYSEC);

          ELSIF typ=CHR(83H) THEN
            newvers:=TRUE;
            satc:=0;
            FOR i:=0 TO 31 DO           (* gps prn number range *)
              IF (i MOD 8) IN CAST(SET8, rxbuf[p+18+i DIV 8]) THEN INC(satc) END;
            END;

          ELSIF typ=CHR(7EH) THEN INC(aux);

--        ELSIF typ=CHR(76H) THEN
--            WrStrLn("76 fill frame");

          ELSIF typ=CHR(78H) THEN
--            IF verb THEN WrStr(" encrypted gps ") END;

--        ELSIF typ=CHR(7FH) THEN
--            WrStrLn("7F short ptu frame");

          ELSIF typ=CHR(80H) THEN
            encr:=TRUE;
            IF verb THEN WrStr(" encrypted ") END;

          END;

--        WrInt(getint16(rxbuf, 3BH), 0);
--        WrStr(" ");WrHex(ORD(typ), 0);WrStr(" ");WrHex(p DIV 256, 0); WrHex(p, 0);
--        WrStr(" ");
        END;

        IF typ=CHR(76H) THEN EXIT END;

        INC(p, len);
      END;
      INC(try);
 
    UNTIL allok OR (try>2);

    IF verb & (nameok>0) THEN 
      WrChan(m);  
      WrStr("R41 ");
      WrStr(id); WrStr(" ");
      WrCard(getcard16(rxbuf, nameok), 1);

      IF date>0 THEN WrStr(" "); DateToStr(date, s); WrStr(s) END;

      IF posok>0 THEN posrs41(rxbuf, posok) END;

      IF satc<100 THEN WrCard(satc, 3);
        IF newvers THEN WrStr("Sat(s) ") ELSE WrStr("Sats ") END;
      END;

      IF rxbuf[nameok+23]=0C THEN
        WrStr(" ");
        WrFixed(FLOAT(getcard16(rxbuf, nameok+26) DIV 64+40000)*0.01, 2,1);
        WrStr("MHz");
      END;
      IF allok THEN
        WrStr(" ");
        WrFixed(FLOAT(ORD(rxbuf[nameok+(2+8)]))*0.1, 1,1); WrStr("V");             (* vbatt *)
      END;
      i:=ORD(rxbuf[nameok+(2+19)]);                                                (* txpow 0..7 *)
      IF i<HIGH(POWERTAB) THEN WrStr(" "); WrInt(POWERTAB[i],1); WrStr("dBm"); END;

      IF aux>0 THEN WrStr(" "); WrInt(aux, 1); WrStr("xAux") END;
      IF encr THEN WrStr(" encrypted part") END;

      IF NOT (allok OR (posok>0) OR (aux>0)) THEN WrStr(" ----  crc err ") END;

      WrdB(chan[m].admax-chan[m].admin);
      WrQ(bitlev0, noise0);
--WrStrLn("");
--FOR i:=0 TO HIGH(rxbuf) DO WrHex(ORD(rxbuf[i]),3) ; IF i MOD 16=15 THEN WrStrLn(""); END; END; 
      IF repl>0 THEN WrStr(" x");WrInt(repl, 1); END;
      IF corr<0 THEN WrStr(" -R");
      ELSIF corr>0 THEN WrStr(" +"); WrInt(corr, 1); WrStr("R") END;
--      Wrtune(chan[m].admax+chan[m].admin, chan[m].admax-chan[m].admin);
      appendsdr(m);
      WrStrLn("");
    END;  
  END;
  IF nameok>0 THEN
    sendrs41(m);
    monid:="";
    IF encr THEN monid:="#" END;
    Append(monid, id);
    monitor(m, "RS41", monid);
  END;
END decode41;


PROCEDURE demodbyte41(m:CARDINAL; d:BOOLEAN);

CONST MAXHEADERR=4;

VAR i,j:CARDINAL;
    normc, revc:CARDINAL;
BEGIN
--WrStr(CHR(ORD(d)+48));
  WITH chan[m].r41 DO
    IF rxp=0 THEN
      synbuf[synp]:=d;
      i:=synp;
      INC(synp);
      IF synp>HIGH(synbuf) THEN synp:=0 END;
      j:=56;
      normc:=0;
      revc:=0;
      REPEAT
        DEC(j);
        IF (RHEAD41[j]="1")=synbuf[i] THEN INC(normc) ELSE INC(revc) END;
        IF i=0 THEN i:=HIGH(synbuf) ELSE DEC(i) END;
      UNTIL (j=24) OR (normc>MAXHEADERR) & (revc>MAXHEADERR);
      headok:=(normc=0) OR (revc=0);
      rev:=normc<revc;
      IF j=24 THEN
        rxp:=7;
        chan[m].framestarttime:=time();
      END;
      rxbitc:=0;
    ELSE
      rxbyte:=rxbyte DIV 2 + 128*ORD(d<>rev);
      INC(rxbitc);
      IF rxbitc>=8 THEN
        rxbuf[rxp]:=CAST(CHAR, CAST(SET8, rxbyte)/CAST(SET8, EXOR41[rxp MOD 64]));

        INC(rxp);
        IF rxp>=HIGH(rxbuf) THEN
          IF chan[m].framestarttime+FRAMELIFETIME>=time() THEN decode41(m) END;
          rxp:=0;
        END;
        IF rxp=200 THEN bitlev0:=bitlev; noise0:=noise END; (* save quality before end of shortst frame *)
        rxbitc:=0;
      END;
    END;
  END;
END demodbyte41;

PROCEDURE demodbit41(m:CARDINAL; u:REAL);
VAR  d:BOOLEAN;
     ua:REAL;
BEGIN
  d:=u>=0.0;
  WITH chan[m].r41 DO
    demodbyte41(m, d);
    
(*quality*)
    ua:=ABS(u)-bitlev;
    bitlev:=bitlev + ua*0.005;
    noise:=noise + (ABS(ua)-noise)*0.02;
(*quality*)

  END;
END demodbit41;


-------------------------------- RS92


PROCEDURE stobyte92(m:CARDINAL; b:CHAR);
VAR i:CARDINAL;
BEGIN
  WITH chan[m].r92 DO
    rxbuf[rxp]:=b;
    IF (rxp>=5) OR (b=CHR(2AH)) THEN INC(rxp) ELSE rxp:=0 END;
    IF rxp=5 THEN chan[m].framestarttime:=time() END;
    IF rxp>=FLENR92 THEN
      rxp:=0;
      IF chan[m].framestarttime+FRAMELIFETIME>=time() THEN decodeframe92(m) END;
    END;
  END;
END stobyte92;


PROCEDURE demodbyte92(m:CARDINAL; d:BOOLEAN);
VAR i, maxi:CARDINAL;
    n, max:INTEGER;
BEGIN
  WITH chan[m].r92 DO
    rxbyte:=rxbyte DIV 2 + 256*ORD(d);
    max:=0;
    maxi:=0;
    FOR i:=0 TO HIGH(asynst) DO
      n:=asynst[i]-asynst[(i+1) MOD (HIGH(asynst)+1)];
      IF ABS(n)>ABS(max) THEN max:=n; maxi:=i END;
    END;
    IF rxbitc=maxi THEN
      IF max<0 THEN rxbyte:=CAST(CARDINAL, CAST(BITSET, rxbyte)/BITSET{0..7}) END;
      stobyte92(m, CHR(rxbyte MOD 256));
    END;
    IF d THEN INC(asynst[rxbitc],(32767-asynst[rxbitc]) DIV 16);
    ELSE DEC(asynst[rxbitc],(32767+asynst[rxbitc]) DIV 16) END; 
    rxbitc:=(rxbitc+1) MOD (HIGH(asynst)+1);
--FOR i:=0 TO HIGH(asynst) DO WrInt(asynst[i], 8) END; WrStrLn("");
  END;
END demodbyte92;


PROCEDURE demodbit92(m:CARDINAL; u, u0:REAL);
VAR d:BOOLEAN;
    ua:REAL;
BEGIN
  d:=u>=u0;
  WITH chan[m].r92 DO
    IF lastmanch=(u0<0.0) THEN INC(manchestd, (32767-manchestd) DIV 16) END;

    lastmanch:=d;
    manchestd:=-manchestd;
    IF manchestd<0 THEN
      demodbyte92(m, d);

(*quality*)
      ua:=ABS(u-u0)-bitlev;
      bitlev:=bitlev + ua*0.005;
      noise:=noise + (ABS(ua)-noise)*0.02;
(*quality*)

    END; 
  END;
END demodbit92;


PROCEDURE demod9241(u:REAL; m:CARDINAL);
VAR d:BOOLEAN;
BEGIN
(*
  IF debfd>=0 THEN
    ui:=VAL(INTEGER, u*0.002);
    WrBin(debfd, ui, 2);
  END;
*)
  WITH chan[m].r92 DO
    d:=u>=0.0;
    IF cbit THEN
      IF savecnt>0 THEN demodbit92(m, u, lastu) END;
      IF chan[m].r41.savecnt>0 THEN demodbit41(m, u) END; 
      IF d<>oldd THEN

        IF d=plld THEN INC(baudfine, pllshift) ELSE DEC(baudfine, pllshift) END;

        oldd:=d;
      END; 

(*
(*quality*)
      ua:=ABS(u)+ABS(lastu);
      bitlev:=bitlev + (ua-bitlev)*0.05;
      noise:=noise + ((ua-bitlev)-noise)*0.05; 
(*quality*)
*)


      lastu:=u;

    ELSE plld:=d END;
    cbit:=NOT cbit;
  END;

END demod9241;


PROCEDURE Fsk(m:CARDINAL);
VAR ff:REAL;
    lim:INTEGER;
BEGIN
  WITH chan[m].r92 DO 
    lim:=demodbaud;
    LOOP
      IF baudfine>=BAUDSAMP THEN
        DEC(baudfine, BAUDSAMP);
        ff:=Fir(afin, baudfine MOD BAUDSAMP DIV (BAUDSAMP DIV AOVERSAMP),
        AOVERSAMP, chan[m].afir, afirtab);
        demod9241(ff, m);
      END;
      INC(baudfine, lim);
      lim:=0;
      IF baudfine<BAUDSAMP*2 THEN EXIT END;

    END;
  END;
END Fsk;


-------------------------------- DFM06


PROCEDURE deinterleave(b-:ARRAY OF BOOLEAN; base, len:CARDINAL; VAR db:ARRAY OF BOOLEAN);
VAR i,j:CARDINAL;
BEGIN
  FOR j:=0 TO 7 DO
    FOR i:=0 TO len-1 DO db[i*8+j]:=b[base+len*j+i] END;
  END;
END deinterleave;

PROCEDURE hamcorr(VAR b:ARRAY OF BOOLEAN; d, h:CARDINAL):BOOLEAN;
VAR e:CARDINAL;
BEGIN
  e:=ORD((b[d]=b[d+2])<>(b[h]=b[h+2])) 
  +2*ORD((b[d+1]=b[d+2])<>(b[h+1]=b[h+2]))
  +4*ORD((b[d+3]=b[h])<>(b[h+1]=b[h+2]));              (* hamming matrix multiplication *)
  IF e>4 THEN b[h+e-4]:=NOT b[h+e-4]                   (* correct hamming bit *)
  ELSIF e>0 THEN b[d+e-1]:=NOT b[d+e-1] END;           (* correct data bit *) 
 
--  IF e<>0 THEN WrStr("<");WrInt(e, 1);WrStr(">") END;
  e:=ORD(b[d])+ORD(b[d+1])+ORD(b[d+2])+ORD(b[d+3])+ORD(b[h])+ORD(b[h+1])+ORD(b[h+2])+ORD(b[h+3]);
  RETURN NOT ODD(e)                                    (* 1 bit checksum *) 
END hamcorr;


PROCEDURE hamming(b-:ARRAY OF BOOLEAN; len:CARDINAL; VAR db:ARRAY OF BOOLEAN):BOOLEAN;
VAR i,j:CARDINAL;
BEGIN
  FOR i:=0 TO HIGH(db) DO db[i]:=FALSE END;
  FOR i:=0 TO len-1 DO
    FOR j:=0 TO 3 DO db[i*4+j]:=b[i*8+j] END;
    FOR j:=0 TO 3 DO db[i*4+j+len*4]:=b[i*8+j+4] END;
    IF NOT hamcorr(db, i*4, i*4+len*4) THEN RETURN FALSE END;
 
  END;
  RETURN TRUE
(*
0000 0000
0001 1110
0010 1101
0011 0011
0100 1011
0101 0101
0110 0110
0111 1000
1000 0111
1001 1001
1010 1010
1011 0100
1100 1100
1101 0010
1110 0001
1111 1111
*)

END hamming;

PROCEDURE bits2val(b-:ARRAY OF BOOLEAN; from, len:CARDINAL):CARDINAL;
VAR n:CARDINAL;
BEGIN
  n:=0;
  WHILE len>0 DO
    n:=n*2 + ORD(b[from]);
    INC(from);
    DEC(len);
  END;
  RETURN n
END bits2val;

PROCEDURE wh(x:CARDINAL);
BEGIN
  x:=x MOD 16;
  IF x<10 THEN WrStr(CHR(x+ORD("0"))) ELSE WrStr(CHR(x+(ORD("A")-10))) END;  
END wh;


PROCEDURE killdfid(m:CARDINAL; all:BOOLEAN);                    (* reset dfm06 name *)
BEGIN
  WITH chan[m].nonames^.dfm6 DO
    IF all THEN idcnt:=0 END;
    idcnt0:=0;
    idcnt1:=0;
    txok:=FALSE;
    id9[0]:=0C;
    idnew:=0;
    frametimeok:=FALSE;
    nameregtop:=0;
    nameregok:=0;
    lastfrid:=0;
    lastfrcnt:=0;
  END;
END killdfid;

PROCEDURE checkdfpos(deg, odeg:REAL; m:CARDINAL);  (* reset dfm06 name on pos jump *)
BEGIN
  IF (deg<>0.0) & (odeg<>0.0) & (ABS(deg-odeg)>0.25) THEN
    IF verb & (chan[m].nonames^.dfm6.id9[0]<>0C) THEN WrStr(" POSITION JUMP! TX STOP ") END;
    killdfid(m, TRUE);
  END;
END checkdfpos;

PROCEDURE checkdf69(alti:REAL; m:CARDINAL);
BEGIN
  chan[m].nonames^.dfm6.d9:=alti<1.0; (* if alti<1 we have swapped values *)
END checkdf69;

PROCEDURE decodesub(b-:ARRAY OF BOOLEAN; m:CARDINAL; subnum:CARDINAL);
CONST MON=ARRAY OF TIME {0,0,31,59,90,120,151,181,212,243,273,304,334};

VAR v,u:CARDINAL;
    vr:REAL;
    ui:INTEGER;
    s:ARRAY[0..100] OF CHAR;
    tmin,thour,tday,tmon,tyear,tt,th,thh:CARDINAL;
    numcntok:BOOLEAN;
BEGIN


  IF verb2 THEN 
    IF subnum=0 THEN WrStr(" Dat") ELSE WrStr(" dat") END;
    wh(bits2val(b, 48, 4)); WrStr(":");
    FOR u:=0 TO 5 DO WrHex(bits2val(b, u*8, 8), 0) END;
  END; 


  CASE bits2val(b, 48, 4) OF
    0: v:=bits2val(b, 24, 8);                         (* framecount *)
       IF verb THEN WrStr(" num: "); WrInt(v, 0); END;

       WITH chan[m].nonames^.dfm6 DO
         numcntok:=FALSE;
         IF ((num+1) MOD 256=v) & wasdate THEN INC(numcnt)  (* date/num+1/date/num+1 sequence ok *)
         ELSE numcnt:=0 END;
         num:=v;
         wasdate:=FALSE;                            (* we have number, next must be date *)
         IF lastdate+60=actdate THEN                (* minute change *)
           IF numcnt>=3 THEN
             timediff:=actdate-time();              (* sonde realtime - systime *)
             numcnt:=0;
             numcntok:=TRUE;
           END;
         END;

         IF (dfmnametyp<512)
         & ((dfmnametyp=0) OR ((idcnt0<dfmidthreshold) OR (idcnt1<dfmidthreshold)) & (lastfrcnt<dfmidthreshold)) THEN (* id with old methode *)
           u:=((v+256-idnum MOD 256) MOD 256+256-(time()+timediff) MOD 256) MOD 256;
           IF u>=128 THEN u:=256-u END;                   (* interpolated time / num compare *)
           txok:=u<=1;                                    (* max +-1s tolerance of num *)
           IF verb THEN
             WrStr(" ["); IntToStr(u, 0, s);
             IF txok THEN Append(s, "s seq]");
             ELSE Append(s, "s OUT OF seq - NO TX]") END;
             WrStr(s);
           END;
           IF numcntok THEN 
             v:=(num+256-actdate MOD 256) MOD 256;
             IF verb THEN WrStr(" NEW ID"); WrInt(v, 0); END;
             idnum:=v;

             s:="DFM6";                                      (* build a name *)
             s[4]:=CHR(v DIV 100 MOD 10 + ORD("0"));
             s[5]:=CHR(v DIV 10 MOD 10 + ORD("0"));
             s[6]:=CHR(v MOD 10 + ORD("0"));
             s[7]:=0C;
             IF StrCmp(idcheck, s) THEN INC(idcnt)           (* got same name again *)
             ELSE                                            (* new name so check if wrong *)
               Assign(idcheck, s);
               idcnt:=1;
             END;
             IF verb THEN WrStr(" MATCHES:"); WrInt(idcnt, 1) END;
             IF (idcnt>dfmidchgthreshold) OR (id9[0]=0C) & (idcnt>dfmidoldthreshold) THEN    (* first name or safe new name *)
               id9:=idcheck;
               idtime:=time();
             END;
           END;

         END;
       END;

       IF chan[m].nonames^.dfm6.d9 THEN                             (* dfm09 speed *)
         v:=bits2val(b, 32, 16);
         IF verb THEN WrFixed(VAL(REAL,v)*(0.01*3.6), 1,0); WrStr(" km/h"); END;
       END;


   |1:
       WITH chan[m].nonames^.dfm6 DO

         IF d9 THEN                             (* dfm09 lat, dir *)
           v:=bits2val(b, 0, 32);
           u:=bits2val(b, 32, 16);
           vr:=FLOAT(v)*0.0000001;
           checkdfpos(vr, lastlat, m);
           lastlat:=vr;
           IF verb THEN
             WrStr(" lat: "); WrFixed(vr, 5,0);
             WrStr(" "); WrFixed(FLOAT(u)*0.01, 1,0); WrStr(" deg");
           END;
         ELSE
           u:=bits2val(b, 24, 16); 
           IF verb THEN
             WrStr(" ms: "); WrInt(u, 0);
           END;
         END;
       END; 

   |2: 

       v:=bits2val(b, 0, 32);
       vr:=FLOAT(v)*0.0000001;
       IF chan[m].nonames^.dfm6.d9 THEN                    (* dfm09 long, clb *)
         ui:=bits2val(b, 32, 16);
         IF ui>=8000H THEN DEC(ui, 10000H) END;            (* signed 16 *)
         checkdfpos(vr, chan[m].nonames^.dfm6.lastlong, m);
         chan[m].nonames^.dfm6.lastlong:=vr;
         IF verb THEN
           WrStr(" long:"); WrFixed(vr, 5,0);
           WrFixed(VAL(REAL,ui)*0.01, 1,0); WrStr("m/s");
         END;

       ELSE                                                (* dfm06 lat, speed *)
 
         u:=bits2val(b, 32, 16); 
         checkdfpos(vr, chan[m].nonames^.dfm6.lastlat, m);
         chan[m].nonames^.dfm6.lastlat:=vr;
         IF verb THEN
           WrStr(" lat: ");WrFixed(vr, 5,0);
           WrStr(" "); WrFixed(FLOAT(u)*(0.01*3.6), 1,0); WrStr("km/h");
         END;
       END;

   |3: IF chan[m].nonames^.dfm6.d9 THEN                             (* dfm09 alt *)

         v:=bits2val(b, 0, 32);
         IF verb THEN
           WrStr(" alti:");WrFixed(FLOAT(v)*0.01, 1,0); WrStr("m ");
         END;

       ELSE                                                (* dfm06 long, dir *)

         v:=bits2val(b, 0, 32);
         u:=bits2val(b, 32, 16);
         vr:=FLOAT(v)*0.0000001;
         checkdfpos(vr, chan[m].nonames^.dfm6.lastlong, m);
         chan[m].nonames^.dfm6.lastlong:=vr;

         IF verb THEN
           WrStr(" long:"); WrFixed(vr, 5,0); 
           WrStr(" "); WrFixed(FLOAT(u)*0.01, 1,0); WrStr(" deg");
         END;
       END;
 
   |4: IF chan[m].nonames^.dfm6.d9 THEN 
       ELSE                                                (* dfm06 alt, clb *)
         v:=bits2val(b, 0, 32);
         checkdf69(FLOAT(v)*0.01, m);                      (* test if dfm6 or dfm9 *)
         ui:=bits2val(b, 32, 16);
         IF ui>=8000H THEN DEC(ui, 10000H) END;            (* signed 16 *)
         IF verb THEN
           WrStr(" alti:");WrFixed(FLOAT(v)*0.01, 1,0); WrStr("m ");
           WrFixed(VAL(REAL,ui)*0.01, 1,0); WrStr(" m/s");
         END;
       END; 
(*
   |5: ui:=bits2val(b, 8, 16);
       IF verb THEN
         WrStr(" mes5:"); WrInt(ui,0);
       END;
   |6: ui:=bits2val(b, 16, 32);
       IF verb THEN
         WrStr(" mes6:"); WrInt(ui,0);
       END;
   |7: ui:=bits2val(b, 16, 32);
       IF verb THEN
         WrStr(" mes7:"); WrInt(ui,0);
       END;
*)
   |8:                                                     (* date *)
       tmin:=bits2val(b, 26, 6);
       thour:=bits2val(b, 21, 5);
       tday:=bits2val(b, 16, 5);
       tmon:=bits2val(b, 12, 4);
       tyear:=bits2val(b, 0, 12);

       IF (tyear>=1970) & (tyear<2100) THEN                (* make unix time *)
         tt:=((tyear-1970)*365 + (tyear-1969) DIV 4);      (* days since 1970 *)
         IF tmon<=12 THEN
           INC(tt, MON[tmon]);
           IF (tyear MOD 4=0) & (tmon>2) THEN INC(tt) END;
         END;
         tt:=(tt + tday-1)*(60*60*24) + thour*3600 + tmin*60;
       ELSE tt:=0 END;
       WITH chan[m].nonames^.dfm6 DO

         IF wasdate THEN numcnt:=0 END;
         wasdate:=TRUE;
         lastdate:=actdate;
         actdate:=tt;


         th:=time();
         IF lastdate+60=actdate THEN      (* minute jump *)
           IF frametimeok THEN thh:=3 ELSE thh:=4 END; (* be more tolerant for first time get *)
           IF lastdatesystime+thh>=th THEN             (* in timespan *)

             frametime:=actdate-th;       (* sonde realtime - systime *)
             frametimeok:=TRUE;
             IF verb THEN WrStr(" got SECOND") END;
           END;
         END;
         lastdatesystime:=th;

         IF verb THEN
           WrStr(" "); 
           IntToStr(tyear, 0, s); Append(s, "-"); WrStr(s);
           IntToStr(tmon, 0, s); Append(s, "-"); WrStr(s);
           IntToStr(tday, 0, s); Append(s, " "); WrStr(s);
           IntToStr(thour, 0, s); Append(s, ":"); WrStr(s);
           IntToStr(tmin, 0, s); WrStr(s);
         END;
       END;
  ELSE
    IF verb & NOT verb2 THEN
      IF subnum=0 THEN WrStr(" Dat") ELSE WrStr(" dat") END;
      wh(bits2val(b, 48, 4)); WrStr(":");
      FOR u:=0 TO 5 DO WrHex(bits2val(b, u*8, 8), 0) END;

    END;
  END;

END decodesub;

PROCEDURE dfmnumtostr(v:CARDINAL; VAR s:ARRAY OF CHAR);
VAR h:ARRAY[0..20] OF CHAR;
BEGIN
  IF dfmoldname THEN
    Assign(s, "DF6");
    s[3]:=hex(v DIV 10000H);
    s[4]:=hex(v DIV 1000H);
    s[5]:=hex(v DIV 100H);
    s[6]:=hex(v DIV 10H);
    s[7]:=hex(v);
    IF HIGH(s)>=8 THEN s[8]:=0C END;
  ELSE
    CardToStr(v MOD 100000000, 0, h);          (* strip to 8 digits no trailing 0 *)
    Assign(s, "D");
    Append(s, h);
  END;
END dfmnumtostr;


PROCEDURE getdfname(b-:ARRAY OF BOOLEAN; m, startbyte:CARDINAL);
VAR v,u,n:CARDINAL;
    s:ARRAY[0..100] OF CHAR;
BEGIN
  WITH chan[m].nonames^.dfm6 DO
    v:=bits2val(b, 0, 8);
    IF v=startbyte THEN
      u:=bits2val(b, 24, 4);
      v:=bits2val(b, 8, 16);
      IF u=1 THEN                                                               (* id low 16 bit*)
        n:=idnew MOD 10000H;
        IF (n=0) OR (n=v) THEN
          INC(idcnt0);
          idtime:=time();
          IF verb THEN WrStr(" ID LOW("); WrInt(idcnt0,1); WrStr(")") END;
        ELSE
          killdfid(m, FALSE);
          IF verb THEN WrStr(" NEW ID LOW") END;
        END; 
        idnew:=CAST(CARDINAL, CAST(SET32, idnew)*SET32{16..31}) + v;
      ELSIF u=0 THEN                                                            (* id high 16 bit*)
        n:=idnew DIV 10000H;
        IF (n=0) OR (n=v) THEN
          INC(idcnt1);
          idtime:=time();
          IF verb THEN WrStr(" ID HIGH("); WrInt(idcnt1,1); WrStr(")") END;
        ELSE
          killdfid(m, FALSE);
          IF verb THEN WrStr(" NEW ID HIGH ") END;
        END;
        idnew:=CAST(CARDINAL, CAST(SET32, idnew)*SET32{0..15}) + v*10000H;
      END;
      IF (idcnt0>=dfmidthreshold) & (idcnt1>=dfmidthreshold) THEN
        dfmnumtostr(idnew, s);
        Assign(id9, s);
        idcheck:=id9;
        txok:=TRUE;
        IF verb THEN WrStr(" ID:");WrStr(s); END;
      END;
    END;
  END;
END getdfname;

PROCEDURE olddfmser(v:CARDINAL; VAR s:ARRAY OF CHAR):BOOLEAN;
VAR i,n:CARDINAL;
BEGIN
  s[0]:="D";
  FOR i:=6 TO 1 BY -1 DO
    n:=v MOD 16;
    IF n>9 THEN RETURN FALSE END;

    s[i]:=CHR(n+ORD("0"));
    v:=ASH(v,-4);
  END;
  s[7]:=0C;
  RETURN TRUE
END olddfmser;

PROCEDURE finddfname(b-:ARRAY OF BOOLEAN; m:CARDINAL);
VAR st:CARD8;
    ix,i,v,thres:CARDINAL;
    d:CARD16;
    s:ARRAY[0..100] OF CHAR;
BEGIN
  WITH chan[m].nonames^.dfm6 DO
    st:=bits2val(b, 0, 8);                                           (* frame start byte *)
    ix:=bits2val(b, 24, 4);                                          (* hi/lo part of ser *)
    d:=bits2val(b, 8, 16);                                           (* data bytes *)
    i:=0;

--find highest channel number single frame serial, (2 frame serial will make a single serial too)
    IF (idcnt0<dfmidthreshold) & (idcnt1<dfmidthreshold) THEN        (* 2 frame serial ok*)
      v:=bits2val(b, 0, 28);
      IF st>ASH(lastfrid,-20) THEN
        lastfrid:=v;
        IF verb THEN WrStr(" MAXCH") END;
        lastfrcnt:=0;
      ELSIF st=ASH(lastfrid,-20) THEN                                (* same id found *)
        IF v=lastfrid THEN
          INC(lastfrcnt);

          thres:=dfmidthreshold*2;
          IF ix<=1 THEN thres:=thres*2 END;                          (* may be a 2 frame serial so increase safety level *)
          IF st DIV 16<>6 THEN thres:=thres*2 END;                   (* may be not a dfm6 so increase safety level *)
          
          IF lastfrcnt>=thres THEN                                   (* id found *)
            IF lastfrcnt=thres THEN
--            dfmnumtostr(v MOD 100000H, s);                       (* which bits are ser? *) 
              IF olddfmser(v, s) THEN
                Assign(id9, s);
                idcheck:=id9;
                txok:=TRUE;
                IF verb THEN WrStr(" NEW MAXCHID:"); WrStr(s); END;
              ELSE
                lastfrcnt:=0;
                IF verb THEN WrStr(" NOT NUMERIC SERIAL") END;
              END;  
            END;
            idtime:=time();
          ELSIF verb THEN
            WrStr(" MAXCHCNT/SECURITYLEVEL:"); WrInt(lastfrcnt,1);
            WrStr("/"); WrInt(thres,1);
          END;

        ELSE lastfrid:=v; lastfrcnt:=0 END;                          (* not stable ser *)
      END;
    END;
--find highest channel number single frame serial

(*
    IF verb & (st=lastfrid) THEN
      CASE lastfrid DIV 16 OF
         7:WrStr(" PS-15");
        |0AH, 0BH:WrStr(" DFM-09");
        |0CH, 0DH:WrStr(" DFM-17");
      ELSE WrStr(" DFM-unknown");
      END;
    END;
*)
    WHILE (i<nameregtop) & (namereg[i].start<>st) DO INC(i) END;
    IF i<nameregtop THEN                                             (* start byte found *)
      WITH namereg[i] DO
        IF (ix<=1) & ((cnt[ix]=0) OR (dat[ix]=d)) THEN
          dat[ix]:=d;
          IF cnt[ix]<255 THEN INC(cnt[ix]) END;

          IF verb2 OR verb (* & (idcnt0=0)*) THEN
            WrStr(" ID:"); WrStr(hex(st DIV 16)); WrStr(hex(st));
            WrStr("["); WrInt(ix,1); WrStr("] CNT:"); WrInt(cnt[0], 1); WrStr(","); WrInt(cnt[1], 1);
          END;
          IF (cnt[0]>=dfmidthreshold) & (cnt[1]>=dfmidthreshold) THEN 
            IF idcnt0=0 THEN 
              idcnt0:=cnt[0];
              idcnt1:=cnt[1];
              nameregok:=i;
              dfmnumtostr(VAL(CARDINAL, dat[0])*10000H + VAL(CARDINAL, dat[1]), s);
              Assign(id9, s);
              idcheck:=id9;
              txok:=TRUE;
              IF verb THEN WrStr(" NEW AUTOID:"); WrStr(s); END;
            END;
            IF nameregok=i THEN

IF verb2 OR verb THEN WrStr(" IDOK ") END; 
              idtime:=time();
            END;                   
          END;
        ELSE                                                         (* data changed so not ser *)
          cnt[0]:=0;
          cnt[1]:=0;
          IF nameregok=i THEN idcnt0:=0; idcnt1:=0; END;             (* found id wrong *)
        END;
      END;

    ELSIF ix<=1 THEN                                                 (* make new entry *)
      WITH namereg[nameregtop] DO
        start:=st;
        cnt[0]:=0;
        cnt[1]:=0;
        dat[ix]:=d;
        cnt[ix]:=1;
      END; 
      IF nameregtop<HIGH(namereg) THEN INC(nameregtop) END;
    END; 
  END;
END finddfname;


PROCEDURE decodeframe6(m:CARDINAL); 
VAR i,j,w:CARDINAL;
    rt,tnow:TIME; 
    s:ARRAY[0..200] OF CHAR;
    tx:BOOLEAN;
BEGIN
  WITH chan[m].nonames^.dfm6 DO

    deinterleave(chan[m].dfm6a.rxbuf, 0, 7, ch);
    deinterleave(chan[m].dfm6a.rxbuf, 56, 13, dh1);
    deinterleave(chan[m].dfm6a.rxbuf, 160, 13, dh2);

    IF hamming(dh1, 13, db1) & hamming(dh2, 13, db2) THEN

      tnow:=time();
--    IF tused+CONTEXTLIFE<tnow THEN id[0]:=0C; nameregtop:=0 END;  (* timed out context *)
      IF tused+CONTEXTLIFE<tnow THEN killdfid(m, TRUE) END;  (* timed out context *)
      tused:=tnow;

      chan[m].nonames^.lastvalid:=tnow;
      IF verb THEN
        WrChan(m);
        IF id9[0]<>0C THEN WrStr(id9) ELSIF d9 THEN WrStr("DF9") ELSE WrStr("DFM") END;
        WrdB(chan[m].admax-chan[m].admin);
        WrQ(chan[m].dfm6a.bitlev, chan[m].dfm6a.noise);
--        Wrtune(chan[m].admax+chan[m].admin, chan[m].admax-chan[m].admin);
(*
        WrStr(" ");
        IF frametimeok THEN wrdate(tnow()+chan[m].dfm6.frametime);
        ELSE WrStr("[wait for GPS Time]") END;
*)
      END;

      IF hamming(ch, 7, cb) THEN
        IF verb THEN
          WrStr(" ");
          FOR i:=0 TO 6 DO wh(bits2val(cb, i*4, 4)) END;
        END;
        IF dfmnametyp>=256 THEN
          IF dfmnametyp MOD 256<>0 THEN getdfname(cb, m, dfmnametyp MOD 256) ELSE finddfname(cb, m) END;
        END;
      END;

      decodesub(db1, m, 0);
      decodesub(db2, m, 1);

-- build tx frame
--    WITH chan[m].nonames^.dfm6 DO
        tx:=(id9[0]<>0C) & StrCmp(idcheck, id9) & (idtime+DFIDTIMEOUT>tnow);
        FOR i:=0 TO 9 DO s[i]:=0C END;
        IF tx & txok THEN                                 (* else stop sending if ambigous id *)
          FOR i:=0 TO 8 DO s[i]:=id9[i] END;              (* sonde id or zero string for no tx *)
        END;

        WITH chan[m] DO                                   (* my call if set *)
          s[10]:=CHR(mycallc DIV (256*256*256));
          s[11]:=CHR(mycallc DIV (256*256) MOD 256);
          s[12]:=CHR(mycallc DIV (256) MOD 256);
          s[13]:=CHR(mycallc MOD 256);
          IF mycallc>0 THEN s[14]:=myssid ELSE s[14]:=CHR(16) END;
        END;

        IF frametimeok THEN rt:=tnow+frametime ELSE rt:=0 END;  (* interpolated sonde realtime *)
        s[15]:=CHR(rt DIV (256*256*256));
        s[16]:=CHR(rt DIV (256*256) MOD 256);
        s[17]:=CHR(rt DIV (256) MOD 256);
        s[18]:=CHR(rt MOD 256);

        j:=19; 
        FOR i:=0 TO 3 DO s[j]:=CHR(bits2val(cb,  i*8, 8)); INC(j) END;    (* payload *)
        FOR i:=0 TO 6 DO s[j]:=CHR(bits2val(db1, i*8, 8)); INC(j) END;    (* payload *)
        FOR i:=0 TO 6 DO s[j]:=CHR(bits2val(db2, i*8, 8)); INC(j) END;    (* payload *)
        sdrparm(s, j, m);
        alludp(chan[m].udptx, j, s);

        IF verb & NOT tx & (id9[0]<>0C) THEN
          IF NOT StrCmp(idcheck, id9) THEN
            WrStrLn(""); WrStr(" changing id "); WrStr(id9); WrStr("<->"); WrStr(idcheck);
          ELSE WrStrLn(""); WrStr(" no tx, id timeout ") END; 
        END;
--    END;
--build tx frame
      monitor(m, "DFM", id9);
      setactiv(chan[m].dfm6a.savecnt, 30);
      IF verb THEN
        appendsdr(m);
        WrStrLn("");
      END;

    END;
  END;
END decodeframe6;


PROCEDURE demodbyte6(m:CARDINAL; d:BOOLEAN);
BEGIN
--  WrInt(ORD(d),1);
  WITH chan[m].dfm6a DO
    chan[m].nonames^.dfm6.synword:=chan[m].nonames^.dfm6.synword*2 + ORD(d);
    IF rxp>=FLEN6 THEN 
      IF chan[m].nonames^.dfm6.synword MOD 10000H=DFMSYN THEN rxp:=0
      ELSIF chan[m].nonames^.dfm6.synword MOD 10000H=0FFFFH-DFMSYN THEN       (* inverse start sequence found *)
        polarity:=NOT polarity;
        rxp:=0;
      END;
      IF rxp=0 THEN chan[m].framestarttime:=time() END;
    ELSE 
      rxbuf[rxp]:=d;
      INC(rxp);
      IF (rxp=FLEN6) & (chan[m].framestarttime+FRAMELIFETIME>=time()) THEN decodeframe6(m) END;
    END; 
  END;

END demodbyte6;

PROCEDURE demodbit6(m:CARDINAL; u,u0:REAL);
VAR d:BOOLEAN;
    ua:REAL;
BEGIN
--WrFixed(u,0,9); WrStr(" ");

  d:=u>=u0;
  WITH chan[m].dfm6a DO
    IF lastmanch=(u0<0.0) THEN INC(manchestd, (32767-manchestd) DIV 16) END;

    lastmanch:=d;
    manchestd:=-manchestd;
--WrInt(manchestd,8);
    IF (manchestd<0) (*=polarity*) THEN
      demodbyte6(m, d<>polarity); 

(*quality*)
      ua:=ABS(u-u0)-bitlev;
      bitlev:=bitlev + ua*0.005;
      noise:=noise + (ABS(ua)-noise)*0.02;
(*quality*)

    END;
  END;
END demodbit6;


PROCEDURE demod6(u:REAL; m:CARDINAL);
VAR d:BOOLEAN;
BEGIN
(*
  IF debfd>=0 THEN
    ui:=VAL(INTEGER, u*0.002);
    WrBin(debfd, ui, 2);
  END;
*)
  WITH chan[m].dfm6a DO
    d:=u>=0.0;
    IF cbit THEN
      demodbit6(m, u, lastu);
      IF d<>oldd THEN

        IF d=plld THEN INC(baudfine, pllshift) ELSE DEC(baudfine, pllshift) END;

        oldd:=d;
      END;
      lastu:=u;
    ELSE plld:=d END;
    cbit:=NOT cbit;
  END;

END demod6;


PROCEDURE Fsk6(m:CARDINAL);
VAR ff:REAL;
    lim:INTEGER;
BEGIN
  WITH chan[m].dfm6a DO
    lim:=demodbaud;
    LOOP
      IF baudfine>=BAUDSAMP THEN
        DEC(baudfine, BAUDSAMP);
        ff:=Fir(afin, baudfine MOD BAUDSAMP DIV (BAUDSAMP DIV AOVERSAMP),
        AOVERSAMP, chan[m].afir, afirtab);
        demod6(ff, m);
      END;
      INC(baudfine, lim);
      lim:=0;
      IF baudfine<BAUDSAMP*2 THEN EXIT END;

    END;
  END;
END Fsk6;


-------------------------------- C34 C50

PROCEDURE SaveReal(c:CARDINAL):REAL;
VAR e:CARDINAL;
BEGIN
  e:=c DIV 1000000H;
  IF e=07FH THEN RETURN MAX(REAL) ELSIF e=0FFH THEN RETURN MIN(REAL) END;
  RETURN CAST(REAL, c); 
END SaveReal;


PROCEDURE demodframe34(channel:CARDINAL);

VAR i, sum1, sum2, val, flen:CARDINAL;
    hr:LONGREAL;
    s:ARRAY[0..100] OF CHAR;
    ok:BOOLEAN;
BEGIN

  WITH chan[channel].nonames^.c34 DO
    sum1:=0;
    sum2:=0100FFH;
    FOR i:=2 TO 6 DO
      INC(sum1, ORD(chan[channel].c34a.rxbuf[i]));
      DEC(sum2, ORD(chan[channel].c34a.rxbuf[i])*(7-i));
    END;
    sum1:=sum1 MOD 256;
    sum2:=sum2 MOD 256;
    ok:=(sum1=ORD(chan[channel].c34a.rxbuf[7])) & (sum2=ORD(chan[channel].c34a.rxbuf[8]));

    IF tused+CONTEXTLIFE<time() THEN id34.id[0]:=0C; id50.id[0]:=0C; END; (* timed out context *)

    IF verb & ok OR verb2 THEN
      IF maxchannels>0 THEN
        WrInt(channel+1, 1); WrStr(":");
      END;
      IF c50 THEN WrStr("C50 ");WrStr(id50.id); ELSE WrStr("C34 "); WrStr(id34.id); END;
      WrdB(chan[channel].admax-chan[channel].admin);
      WrQuali(noiselevel(chan[channel].c34a.bitlev, chan[channel].c34a.noise));
--      Wrtune(chan[channel].admax+chan[channel].admin, chan[channel].admax-chan[channel].admin);
      WrStr(" [");
      WrHex(ORD(chan[channel].c34a.rxbuf[2]), 2);
      WrStr(" ");
      WrHex(ORD(chan[channel].c34a.rxbuf[3]), 2);
      WrHex(ORD(chan[channel].c34a.rxbuf[4]), 2);
      WrHex(ORD(chan[channel].c34a.rxbuf[5]), 2);
      WrHex(ORD(chan[channel].c34a.rxbuf[6]), 2);
      WrStr(" ");
      WrHex(ORD(chan[channel].c34a.rxbuf[7]), 2);
      WrHex(ORD(chan[channel].c34a.rxbuf[8]), 2);
      WrStr("] ");
    END;

    IF ok THEN (* chksum ok *)
--INC(test1); WrInt(test1, 6); WrStrLn(" testcnt");
      chan[channel].nonames^.lastvalid:=time();
      val:=ORD(chan[channel].c34a.rxbuf[6]) + ORD(chan[channel].c34a.rxbuf[5])*0100H
         + ORD(chan[channel].c34a.rxbuf[4])*010000H +ORD(chan[channel].c34a.rxbuf[3])*01000000H;
      hr:=SaveReal(val);
--      IF hr<0.0 THEN END;

--WrFixed(hr, 10, 20);
      IF c50 THEN
        IF id50.idtime+CIDTIMEOUT<time() THEN
          id50.id[0]:=0C;
          id50.idcheck[0]:=0C;
          id50.idcnt:=0;
        END;                                                          (* remove old id *)

        CASE chan[channel].c34a.rxbuf[2] OF
         CHR(03H): IF (hr<99.9) & (hr>-99.9) THEN
                      IF verb THEN WrStr("tair "); WrFixed(hr, 1, 0); WrStr("oC"); END;
                    END;

         |CHR(04H): IF (hr<99.9) & (hr>-99.9) THEN
                      IF verb THEN WrStr("thum "); WrFixed(hr, 1, 0); WrStr("oC"); END;
                    END;

         |CHR(05H): IF (hr<99.9) & (hr>-99.9) THEN
                      IF verb THEN WrStr("tcha "); WrFixed(hr, 1, 0); WrStr("oC"); END;
                    END;

         |CHR(06H): IF (hr<99.9) & (hr>-99.9) THEN
                      IF verb THEN WrStr("to3  "); WrFixed(hr, 1, 0); WrStr("oC"); END;
                    END;

         |CHR(07H): 
                    IF verb THEN WrStr("io3  "); WrFixed(hr, 1, 0); WrStr("uA"); END;

         |CHR(10H): IF (hr<=100.0) & (hr>=0.0) THEN
                      IF verb THEN WrStr("hum  "); WrFixed(hr, 1, 0); WrStr("%"); END;
                    END;

         |CHR(14H): IF verb THEN
                      WrStr("date");
                      IntToStr(val MOD 1000000 + 1000000, 1, s); s[0]:=" "; WrStr(s);
                    END;

         |CHR(15H): IF verb THEN 
                      TimeToStr(val DIV 10000 * 3600 + val MOD 10000 DIV 100 * 60 + val MOD 100, s);
                      WrStr("time "); WrStr(s);
                    END;

         |CHR(16H):
                    hr:=latlong(val, c50);
                    IF (hr<89.9) & (hr>-89.9) THEN 
                      IF verb THEN WrStr("lat  "); WrFixed(hr, 5, 0); END;
                    END;

         |CHR(17H):
                    hr:=latlong(val, c50);
                    IF (hr<180.0) & (hr>-180.0) THEN
                      IF verb THEN WrStr("long "); WrFixed(hr, 5, 0); END;
                    END;

         |CHR(18H):
                    hr:=FLOAT(val)*0.1;
                    IF hr<50000.0 THEN
                      IF verb THEN WrStr("alti "); WrFixed(hr, 1, 0); WrStr("m") END;
                    END;

         |CHR(19H):
                    IF verb THEN WrStr("sped "); WrFixed(hr*3.6, 1, 0); WrStr("km/h") END;

         |CHR(1AH):
                    IF verb THEN WrStr("dir  "); WrFixed(hr, 1, 0); WrStr("deg") END;

--         |CHR(1BH):
--                    IF verb THEN WrStr("1B  "); WrFixed(hr, 5, 0); WrStr("?") END;

         |CHR(64H): s:="SC50";                   (* 66H 67H 68H 89H 6BH seem to be fixed too *)
                    s[4]:=hex(val DIV 1000H MOD 8);
                    s[5]:=hex(val DIV 100H);
                    s[6]:=hex(val DIV 10H);
                    s[7]:=hex(val);
                    s[8]:=0C;
                    s[9]:=0C;
                    IF verb THEN 
                      WrStr("numb ");
                      WrStr(s[4]); WrStr(s[5]); WrStr(s[6]);WrStr(s[7]);WrStr(s[8]);
                    END;
  
-- check name, if changed may be checksum error or 2 sondes on same frequency
                    IF StrCmp(id50.idcheck, s) THEN INC(id50.idcnt) (* got same name again *)
                    ELSE                                            (* new name so check if wrong *)
                      Assign(id50.idcheck, s);
                      idcnt:=1;
                    END;
                    IF (id50.idcnt>2) OR (id50.id[0]=0C) THEN       (* first name or safe new name *)                     
                      id50.id:=id50.idcheck;
                      id50.idtime:=time();
                    END;
                    tused:=time();
                 
        ELSE
          IF verb2 THEN (*WrStr("????");*)
            WrInt(val, 12);
            WrInt(val DIV 65536, 7);
            WrInt(val MOD 65536, 7);
            WrFixed(hr, 2, 10);
            WrStr(" ");
            FOR i:=31 TO 0 BY -1 DO WrStr(CHR(48+ORD(i IN CAST(SET32, val)))); END; 
          END;
        END;
      ELSE                                                         (* SC34 *)
        IF id34.idtime+CIDTIMEOUT<time() THEN
          id34.id[0]:=0C;
          id34.idcheck[0]:=0C;
          id34.idcnt:=0;
        END;                                                          (* remove old id *)
        CASE chan[channel].c34a.rxbuf[2] OF
          CHR(03H): IF (hr<99.9) & (hr>-99.9) THEN
                      IF verb THEN WrStr("tmp1 "); WrFixed(hr, 1, 0); WrStr("oC"); END;
                    END;

         |CHR(07H): IF (hr<99.9) & (hr>-99.9) THEN 
                      IF verb THEN WrStr("dewp "); WrFixed(hr, 1, 0); WrStr("oC"); END;
                    END;

         |CHR(14H): IF verb THEN
                      WrStr("date");
                      IntToStr(val MOD 1000000 + 1000000, 1, s); s[0]:=" "; WrStr(s);
                    END;

         |CHR(15H): IF verb THEN 
                      TimeToStr(val DIV 10000 * 3600 + val MOD 10000 DIV 100 * 60 + val MOD 100, s);
                      WrStr("time "); WrStr(s);
                    END;

         |CHR(16H):
                    hr:=latlong(val, c50);
                    IF (hr<89.9) & (hr>-89.9) THEN 
                      IF verb THEN WrStr("lati "); WrFixed(hr, 5, 0); END;
                    END;

         |CHR(17H):
                    hr:=latlong(val, c50);
                    IF (hr<180.0) & (hr>-180.0) THEN
                      IF verb THEN WrStr("long "); WrFixed(hr, 5, 0); END;
                    END;

         |CHR(18H):
                    hr:=FLOAT(val)*0.1;
                    IF hr<50000.0 THEN
                      IF verb THEN WrStr("alti "); WrFixed(hr, 1, 0); WrStr("m") END;
                    END;

         |CHR(19H):
                    hr:=FLOAT(val)*(0.1*1.852 (*1.609*) (*1.852*));   (* guess knots or miles *)
                    IF hr<1000.0 THEN
                      IF verb THEN WrStr("wind "); WrFixed(hr, 1, 0); WrStr("km/h") END;
                    END;

         |CHR(1AH):
                    hr:=FLOAT(val)*0.1;
                    IF (hr>=0.0) & (hr<=360.0) THEN
                      IF verb THEN WrStr("wdir "); WrFixed(hr, 1, 0); WrStr("deg") END;
                    END;

         |CHR(64H): 
                    s:="SC34";                    (* build a name from seems like serial number *)
                    s[4]:=hex(val DIV 10000H);
                    s[5]:=hex(val DIV 1000H);
                    s[6]:=hex(val DIV 100H);
                    s[7]:=hex(val DIV 10H);
                    s[8]:=hex(val);
                    s[9]:=0C;
                    IF verb THEN 
                      WrStr("numb ");
                      WrStr(s[4]); WrStr(s[5]); WrStr(s[6]);WrStr(s[7]);WrStr(s[8]);
                    END;
  
-- check name, if changed may be checksum error or 2 sondes on same frequency
                    IF StrCmp(id34.idcheck, s) THEN INC(id34.idcnt) (* got same name again *)
                    ELSE                                            (* new name so check if wrong *)
                      Assign(id34.idcheck, s);
                      idcnt:=1;
                    END;
                    IF (id34.idcnt>3) OR (id34.id[0]=0C) THEN       (* first name or safe new name *)                     
                      id34.id:=id34.idcheck;
                      id34.idtime:=time();
                    END;
                    tused:=time();
                 
        ELSE
          IF verb2 THEN WrStr("????"); WrInt(val, 12); WrFixed(hr, 2, 10);
          END;
        END;
      END;
-- build tx frame
      IF (c50 & (id50.id[0]<>0C) & StrCmp(id50.idcheck, id50.id))
      OR (NOT c50 & (id34.id[0]<>0C) & StrCmp(id34.idcheck, id34.id)) THEN (* stop sending if ambigous id *)
        IF c50 THEN 
          FOR i:=0 TO 8 DO s[i]:=id50.id[i] END;
        ELSE 
          FOR i:=0 TO 8 DO s[i]:=id34.id[i] END;
        END;
        s[9]:=0C;

        WITH chan[channel] DO                             (* call if set *)
          s[10]:=CHR(mycallc DIV (256*256*256));
          s[11]:=CHR(mycallc DIV (256*256) MOD 256);
          s[12]:=CHR(mycallc DIV (256) MOD 256);
          s[13]:=CHR(mycallc MOD 256);
          IF mycallc>0 THEN s[14]:=myssid ELSE s[14]:=CHR(16) END;
        END;
        FOR i:=0 TO 6 DO s[i+15]:=chan[channel].c34a.rxbuf[i+2] END;            (* payload *)

        flen:=FLENC34;
        sdrparm(s, flen, channel);
        alludp(chan[channel].udptx, flen, s);
      ELSIF verb THEN 
        IF c50 THEN
          IF id50.id[0]<>0C THEN 
            WrStr(" changing name "); WrStr(id50.id); WrStr("<->"); WrStr(id50.idcheck);
          END;
        ELSIF id34.id[0]<>0C THEN
          WrStr(" changing name "); WrStr(id34.id); WrStr("<->"); WrStr(id34.idcheck);
        END;
      END;
--build tx frame
      IF c50 THEN monitor(channel, "C50", id50.id) ELSE monitor(channel, "C34", id34.id) END;

    ELSIF verb2 THEN
      WrStr("---- chksum ");
      WrHex(sum1, 2);  WrHex(sum2, 2);
    END;

    setactiv(chan[channel].c34a.savecnt, 30);

    IF verb2 OR ok & verb THEN
      appendsdr(channel);
      WrStrLn("");
    END;

  END;
(* name(9) 0C call(5) playload(7) *)
END demodframe34;


PROCEDURE demodbit34(channel:CARDINAL; d:BOOLEAN);
BEGIN
  d:=NOT d;
  WITH chan[channel].c34a DO
    rxbytec:=rxbytec*2 + ORD(d);
    IF rxbytec MOD 10000000H = 0E00EFFEH THEN  (* c34 1110 0000 0000 1110 1111 1111 1110*)
      chan[channel].nonames^.c34.c50:=FALSE;
      rxp:=2;
      rxbitc:=0;
      chan[channel].framestarttime:=time();
    ELSIF rxbytec MOD 200000H = 0BFEH THEN     (* c50 0 0000 0000 1011 1111 1110 *)  
      chan[channel].nonames^.c34.c50:=TRUE;
      rxp:=2;
      rxbitc:=0;
      chan[channel].framestarttime:=time();
    END;

    IF chan[channel].nonames^.c34.c50 OR (rxbitc<>0) OR NOT d THEN
      IF rxbitc<=8 THEN                       (* databits *)
        rxbyte:=rxbyte MOD 256 DIV 2;
        IF d THEN INC(rxbyte, 128) END;
        INC(rxbitc);
      ELSIF rxp>0 THEN                        (* byte ready *)
        rxbitc:=0;
        rxbuf[rxp]:=CHR(rxbyte);
        INC(rxp);
        IF rxp>HIGH(rxbuf) THEN
          IF chan[channel].framestarttime+FRAMELIFETIME>=time() THEN demodframe34(channel) END;
          rxp:=0;
        END;
      END;
    END;
  END;
END demodbit34;


PROCEDURE demod34(u:REAL; channel:CARDINAL);
VAR d:BOOLEAN;
    ua :REAL;
BEGIN
  d:=u>=0.0;
  WITH chan[channel].c34a DO
    IF cbit THEN
      demodbit34(channel, d);
      IF d<>oldd THEN
        IF d=plld THEN INC(baudfine, pllshift) ELSE DEC(baudfine, pllshift) END;
        oldd:=d;
      END;

(*quality*)
      ua:=ABS(u)-bitlev;
      bitlev:=bitlev + ua*0.02;
      noise:=noise + (ABS(ua)-noise)*0.05;
(*quality*)

    ELSE plld:=d END;
    cbit:=NOT cbit;
  END;
END demod34;

PROCEDURE Afsk(channel:CARDINAL);
VAR right, mid, d, a, b, ff:REAL;
BEGIN
  WITH chan[channel].c34a DO
    right:=Fir(afin, 0, AOVERSAMP, chan[channel].afir, afirtab);
    IF (left<0.0)<>(right<0.0) THEN
      d:=left/(left-right);
      a:=FLOAT(TRUNC(d*FLOAT(AOVERSAMP)+0.5));
      b:=a * (1.0/FLOAT(AOVERSAMP));
      IF (TRUNC(a)>0) & (TRUNC(a)<AOVERSAMP) THEN
        mid:=Fir(afin, AOVERSAMP-TRUNC(a), AOVERSAMP, chan[channel].afir, afirtab);
        IF (left<0.0)<>(mid<0.0) THEN d:=left/(left-mid)*b;
        ELSE d:=b + mid/(mid-right)*(1.0-b) END;
      END;
      IF tcnt+d<>0.0 THEN freq:=1.0/(tcnt+d) END;
      tcnt:=0.0-d;
    END;

    tcnt:=tcnt+1.0;
    left:=right;
    dfir[dfin]:=freq - afskmidfreq;
    dfin:=(dfin+1) MOD DFIRLEN;
    INC(baudfine, demodbaud);
    IF baudfine>=BAUDSAMP THEN
      DEC(baudfine, BAUDSAMP);
      IF baudfine<BAUDSAMP THEN       (* normal alway true *)
        ff:=Fir(dfin, DOVERSAMP - baudfine DIV (BAUDSAMP DIV DOVERSAMP), DOVERSAMP, dfir, dfirtab);
        demod34(ff, channel);
      END;
    END;
  END;
END Afsk;

------------------------ M10 M20

PROCEDURE crcm10(len:INTEGER; buf-:ARRAY OF CHAR):CARD16;
VAR i:INTEGER;
    cs, b, t, s:SET16;
BEGIN
  cs:=SET16{};
  FOR i:=0 TO len-1 DO
    b:=CAST(SET16, ORD(buf[i]));
    b:=SHIFT(b, -1) + SHIFT(b*SET16{0}, 7);
    b:=b/(SHIFT(b, -2)*SET16{0..7});
    t:=cs*SET16{0..5} + SHIFT((cs/SHIFT(cs, -2)/SHIFT(cs, -4))*SET16{0}, 6)+SHIFT((SHIFT(cs, -1)/SHIFT(cs, -3)/SHIFT(cs, -5))*SET16{0}, 7);
    s:=SHIFT(cs, -7)*SET16{0..7};
    s:=s/SHIFT(s, -2)*SET16{0..7};
    cs:=SHIFT(cs*SET16{0..7}, 8) + b/t/s;
  END;
  RETURN CAST(CARD16, cs)   
END crcm10;

PROCEDURE m10card(b-:ARRAY OF CHAR; pos, len:INTEGER):CARDINAL;
VAR i:INTEGER;
    n:CARDINAL;
BEGIN
  n:=0;
  FOR i:=0 TO len-1 DO n:=n*256 + ORD(b[pos+i]) END;
  RETURN n
END m10card;

PROCEDURE m10rcard(b-:ARRAY OF CHAR; pos, len:INTEGER):CARDINAL;
VAR i:INTEGER;
    n:CARDINAL;
BEGIN
  n:=0;
  FOR i:=len-1 TO 0 BY -1 DO n:=n*256 + ORD(b[pos+i]) END;
  RETURN n
END m10rcard;


PROCEDURE decodeframe10(m:CARDINAL); 

CONST DEGMUL=1.0/FLOAT(0B60B60H);
      VMUL=0.005;
      CRCPOS=99;
--      HSET  =SET256{0..2,4..25,32,33,93..97,99,100};                (* not hexlist known bytes *)
      HSET  =SET256{0..2,4..25,32,33,99,100};                (* not hexlist known bytes *)
      VARSET=SET256{4..9,11..13,15..17,19..21,23..25,53..54,63,69,71,72,85,87,89,90,98..100};  (* known as variable *)

      Rs=ARRAY OF REAL {12100.0, 36500.0,  475000.0};
      Rp=ARRAY OF REAL {0.000000000000000121, 0.11060606, 0.15833333};


VAR i, tow, week, tab, flen, id, repl, gpstimecorr:CARDINAL;
    ci:INTEGER;
    lat, lon, alt, ve, vn, vv, v, dir:LONGREAL;
    
    sct:CARDINAL;
    rt, rh:REAL;
    tok, crcok:BOOLEAN;
    repairstep:CARD8;
    s, ids:ARRAY[0..200] OF CHAR;

BEGIN
  WITH chan[m].m10 DO
    txok:=FALSE;
    repairstep:=16; 
    repl:=0;
    LOOP
      crcok:=(crcm10(CRCPOS, rxbuf)=m10card(rxbuf, CRCPOS, 2));
      IF alternativ OR crcok OR (repairstep=0) THEN EXIT END;

      repl:=0;
      FOR i:=0 TO CRCPOS-1 DO
        IF NOT (i IN  VARSET) & (fixcnt[i]>=repairstep) THEN        (* replace stable bytes *)
          IF rxbuf[i]<>fixbytes[i] THEN
            INC(repl);
            rxbuf[i]:=fixbytes[i];
          END;
        END;
      END;
      repairstep:=repairstep DIV 2;                                 (* make next crc check *)
    END;    

    IF crcok THEN
--INC(test1); WrInt(test1, 6); WrStrLn(" testcnt"); 
-- update fixbyte statistics
      FOR i:=0 TO CRCPOS-1 DO
        IF fixbytes[i]=rxbuf[i] THEN
          IF fixcnt[i]<255 THEN INC(fixcnt[i]) END;
        ELSE
          fixbytes[i]:=rxbuf[i];
          fixcnt[i]:=0;
        END;
      END;
-- update fixbyte statistics

-- get ID   

-- IF m10newID THEN
      ids[0]:="M";
      ids[1]:="E";
      ids[2]:=hex(ORD(rxbuf[95]) DIV 16);              (* should be 0..9 *)
      ids[3]:=hex(ORD(rxbuf[95]));
      ids[4]:=hex(ORD(rxbuf[93]));
      id:=ORD(rxbuf[96])+ORD(rxbuf[97])*256;
      ids[5]:=hex(id DIV 4096);
      ids[6]:=hex(id DIV 256);
      ids[7]:=hex(id DIV 16);
      ids[8]:=hex(id);
      ids[9]:=0C;
(* 
   ELSE

     id:=CAST(CARDINAL,
         (CAST(SET32, ORD(rxbuf[97]) + 100H*ORD(rxbuf[96]) + 10000H*ORD(rxbuf[95]))
        /CAST(SET32, ORD(rxbuf[93]) DIV 10H + 10H*ORD(rxbuf[94]) + 1000H*ORD(rxbuf[95])))
         *SET32{0..19});
     i:=8;
     ids[i]:=0C;
     DEC(i);
     REPEAT
       ids[i]:=CHR(id MOD 10 + ORD("0"));
       id:=id DIV 10;
       DEC(i);
     UNTIL i=1;
     ids[i]:="E";
     DEC(i);
     ids[i]:="M";
   END;
*)
-- get ID

      IF alternativ THEN
        IF verb THEN
          WrChan(m);
          WrStr("M10 ");
          WrStr(ids);
          WrStr(" ");
          wrtime(timefn MOD 86400);
          WrStr(" typ="); WrInt(m10card(rxbuf, 2, 1),1); WrStr(" ");
        END;

      ELSE
        tow:=m10card(rxbuf, 10, 4);
        week:=m10card(rxbuf, 32, 2);
        gpstimecorr:=ORD(rxbuf[31]);
        timefn:=tow DIV 1000 + week*(7*DAYSEC) + 3657*DAYSEC - gpstimecorr; 
--        IF verb2 THEN WrStr(" ");DateToStr(time, s); WrStr(s); WrStr(" ") END;
        lat:=VAL(LONGREAL, CAST(INTEGER, m10card(rxbuf, 14, 4)))*DEGMUL;
        lon:=VAL(LONGREAL, CAST(INTEGER, m10card(rxbuf, 18, 4)))*DEGMUL;
        alt:=VAL(LONGREAL, m10card(rxbuf, 22, 4))*0.001;
        ci:=m10card(rxbuf, 4, 2); IF ci>32767 THEN DEC(ci, 65536) END;
        ve:=VAL(LONGREAL, ci)*VMUL;
        ci:=m10card(rxbuf, 6, 2); IF ci>32767 THEN DEC(ci, 65536) END;
        vn:=VAL(LONGREAL, ci)*VMUL;
        ci:=m10card(rxbuf, 8, 2); IF ci>32767 THEN DEC(ci, 65536) END;
        vv:=VAL(LONGREAL, ci)*VMUL;
        v:=sqrt(ve*ve + vn*vn);                           (* hor speed *)
        dir:=atang2(vn, ve)*(1.0/RAD);
        IF dir<0.0 THEN dir:=360.0+dir END;
        txok:=TRUE;

--- m10 temp
        tok:=FALSE;
        sct:=m10rcard(rxbuf, 62, 1);
        rt:=VAL(REAL, m10rcard(rxbuf, 63, 2) MOD 4096);
(*
        tcal0:=m10rcard(rxbuf, 65, 2);
        tcal1:=m10rcard(rxbuf, 67, 2);
*)
        rt:=(4095.0-rt)/rt-Rp[sct];
        IF (rt>0.0) & (sct<3) THEN;
          rt:=Rs[sct]/rt;
          IF rt>0.0 THEN 
            rt:=log(rt);
            rt:=1.0/(1.07303516E-03 + 2.41296733E-04*rt + 2.26744154E-06*rt*rt
                    + 6.52855181E-08*rt*rt*rt) - 273.15;
            tok:=(rt>-99.0) & (rt<50.0); 
          END;
        END;
--- m10 hum

        IF verb THEN
          WrChan(m);
          WrStr("M10 ");
          WrStr(ids);
          WrStr(" "); 
          DateToStr(timefn, s); WrStr(s);
--          wrtime(timefn MOD 86400);
          WrStr(" ");
          WrFixed(lat, 5, 1);
          WrStr(" ");
          WrFixed(lon, 5, 1);
          WrStr(" ");
          IF (alt<100000.0) & (alt>-100000.0) THEN
            WrInt(VAL(INTEGER, alt), 1);
            WrStr("m ");
          END;
          WrFixed(v*3.6, 1, 1);
          WrStr("km/h ");
          WrInt(VAL(INTEGER,dir), 1);
          WrStr("deg ");
          WrFixed(vv, 1, 1);
          WrStr("m/s");
          IF tok THEN WrStr(" "); WrFixed(rt, 1, 1); WrStr("C") END;
        END;

      END;
-- build tx frame
      IF txok THEN
        FOR i:=0 TO 8 DO s[i+7]:=ids[i] END;
 
        WITH chan[m] DO                                             (* call if set *)
          s[0]:=CHR(mycallc DIV (256*256*256));
          s[1]:=CHR(mycallc DIV (256*256) MOD 256);
          s[2]:=CHR(mycallc DIV (256) MOD 256);
          s[3]:=CHR(mycallc MOD 256);
          IF mycallc>0 THEN s[4]:=myssid ELSE s[4]:=CHR(16) END;
          s[5]:=0C;
          s[6]:=0C;
        END;
        FOR i:=0 TO FLEN10-1 DO s[i+16]:=rxbuf[i] END;              (* payload *)

        flen:=16+FLEN10;
        sdrparm(s, flen, m);
        alludp(chan[m].udptx, flen, s);
      END;
--build tx frame
      monitor(m, "M10", ids);
 

    ELSIF verb THEN 
      WrChan(m);
      WrStr("M10 crc error");
    END;

    setactiv(savecnt, 30);

    IF verb THEN
      WrdB(chan[m].admax-chan[m].admin);
      WrQuali(noiselevel(bitlev, noise));
      IF repl>0 THEN WrStr(" +r");WrInt(repl, 1);WrStr("/");WrInt(repairstep, 1); END;
--      Wrtune(chan[m].admax+chan[m].admin, chan[m].admax-chan[m].admin);
      appendsdr(m);
    END;
    IF verb2 THEN
(*
      FOR i:=0 TO 23 DO
        IF i MOD 10=0 THEN WrStrLn("") END;
        WrInt(m10card(rxbuf, 48+i*2, 2), 6); WrStr(" ");
      END;
*)

      tab:=0;
      FOR i:=0 TO 100 DO
        IF alternativ OR NOT (i IN HSET) THEN
          IF tab MOD 12=0 THEN WrStrLn("") END;
          WrInt(i,3);WrStr(":");WrHex(CAST(INTEGER, m10card(rxbuf, i, 1)), 3); INC(tab);
        END;
      END;

    END;
    IF verb THEN WrStrLn("") END;

  END;
END decodeframe10;


PROCEDURE decodeframe20(m:CARDINAL); 

CONST DEGMUL=1.0/1000000.0;
      VMUL=0.01;
--    CRCPOS=68;
      CRCPOSB=22;
--    HSET  =SET256{0..2,4..25,32,33,93..97,99,100};                (* not hexlist known bytes *)
      HSET  =SET256{};                (* not hexlist known bytes *)
      VARSET=SET256{2,4,6,8..10,11..14,17,21..25,28..35,68,69}; (* known as variable *)

VAR i, frl, tow, week, tab, flen, id, repl, gpstimecorr, fnum:CARDINAL;
    ci:INTEGER;
    lat, lon, alt, ve, vn, vv, v, dir:LONGREAL;
    
    sct:CARDINAL;
    rt, rh:REAL;
    tok, crcok, crcbok:BOOLEAN;
    repairstep:CARD8;
    s, ids:ARRAY[0..200] OF CHAR;

BEGIN
  WITH chan[m].m10 DO
    FILL(ADR(ids), 0C, SIZE(ids));
    txok:=FALSE;
    repairstep:=16; 
    repl:=0;

--check first block
    FOR i:=1 TO CRCPOSB-1 DO s[i]:=rxbuf[i+1] END;
    s[0]:=CHR(16H);
    crcbok:=(crcm10(CRCPOSB-1, s)=m10card(rxbuf, CRCPOSB, 2));      (* inner block crc may be removed *)
    frl:=m10card(rxbuf, 0, 1)+1;                                    (* frame length (?) *)
    IF frl>HIGH(rxbuf) THEN frl:=HIGH(rxbuf) END;
    IF frl>2 THEN
      LOOP                                                            (* repair bytes *)
        crcok:=(crcm10(frl-2, rxbuf)=m10card(rxbuf, frl-2, 2));
        IF (*alternativ OR*) crcok OR (repairstep=0) THEN EXIT END;

        repl:=0;
        IF crcbok THEN i:=CRCPOSB+2 ELSE i:=0 END;                    (* first block is ok *)
        REPEAT
          IF NOT (i IN  VARSET) & (fixcnt[i]>=repairstep) THEN        (* replace stable bytes *)
            IF rxbuf[i]<>fixbytes[i] THEN
              INC(repl);
              rxbuf[i]:=fixbytes[i];
            END;
          END;
          INC(i);
        UNTIL i>=frl-2;
        repairstep:=repairstep DIV 2;                                 (* make next crc check *)
      END;    

      IF crcok THEN
-- update fixbyte statistics
        FOR i:=0 TO frl-2 DO                                          (* save good bytes *)
          IF fixbytes[i]=rxbuf[i] THEN
            IF fixcnt[i]<255 THEN INC(fixcnt[i]) END;                 (* how long got same byte *)
          ELSE
            fixbytes[i]:=rxbuf[i];
            fixcnt[i]:=0;
          END;
        END;
-- update fixbyte statistics

-- get ID
        ids:="ME0000000";
        id:=m10rcard(rxbuf, 19, 2) DIV 4;
        ids[8]:=CHR(id MOD 10+ORD("0"));
        ids[7]:=CHR(id DIV 10 MOD 10+ORD("0"));
        ids[6]:=CHR(id DIV 100 MOD 10+ORD("0"));
        ids[5]:=CHR(id DIV 1000 MOD 10+ORD("0"));
        ids[4]:=CHR(id DIV 10000 MOD 10+ORD("0"));
        id:=m10card(rxbuf, 18, 1);
        ids[3]:=hex(id);
        ids[2]:=hex(id DIV 16);
-- get ID
(*
        IF alternativ THEN
          IF verb THEN
            WrChan(m);
            WrStr("M20 ");
            WrStr(ids);
            WrStr(" ");
            wrtime(timefn MOD 86400);
            WrStr(" typ="); WrInt(m10card(rxbuf, 2, 1),1); WrStr(" ");
          END;

        ELSE
*)
(*
0    framelen 45
1    type 20
2-3  adc
4-5  adc
6-7  ad temp
22-23 block check or what else
*)
        tow:=m10card(rxbuf, 15, 3);
        week:=m10card(rxbuf, 26, 2);
        gpstimecorr:=GPSTIMECORR;
        timefn:=tow + week*(7*DAYSEC) + 3657*DAYSEC - gpstimecorr;
        lat:=VAL(LONGREAL, CAST(INTEGER, m10card(rxbuf, 28, 4)))*DEGMUL;
        lon:=VAL(LONGREAL, CAST(INTEGER, m10card(rxbuf, 32, 4)))*DEGMUL;
        ci:=m10card(rxbuf, 24, 2); IF ci>32767 THEN DEC(ci, 65536) END;
        vv:=VAL(LONGREAL, ci)*VMUL;
        txok:=TRUE;
        fnum:=m10card(rxbuf, 21, 1); 
--      IF verb2 THEN WrStr(" ");DateToStr(time, s); WrStr(s); WrStr(" ") END;
        ci:=m10card(rxbuf, 8, 3); IF ci>32767*256 THEN DEC(ci, 65536*256) END;  (* is it signed? *)
        alt:=VAL(LONGREAL, ci)*0.01;
        ci:=m10card(rxbuf, 11, 2); IF ci>32767 THEN DEC(ci, 65536) END;
        ve:=VAL(LONGREAL, ci)*VMUL;
        ci:=m10card(rxbuf, 13, 2); IF ci>32767 THEN DEC(ci, 65536) END;
        vn:=VAL(LONGREAL, ci)*VMUL;
        v:=sqrt(ve*ve + vn*vn);                           (* hor speed *)
        dir:=atang2(vn, ve)*(1.0/RAD);
        IF dir<0.0 THEN dir:=360.0+dir END;

        IF verb THEN
          WrChan(m);
          WrStr("M20 ");
          WrStr(ids);
          WrStr(" "); 
          WrInt(fnum, 1);
          WrStr(" ");
          DateToStr(timefn, s); WrStr(s);
--        wrtime(timefn MOD 86400);
          WrStr(" ");
          WrFixed(lat, 5, 1);
          WrStr(" ");
          WrFixed(lon, 5, 1);
          WrStr(" ");
          IF (alt<100000.0) & (alt>-100000.0) THEN
            WrInt(VAL(INTEGER, alt), 1);
            WrStr("m ");
          END;
          WrFixed(v*3.6, 1, 1);
          WrStr("km/h ");
          WrInt(VAL(INTEGER,dir), 1);
          WrStr("deg ");
          WrFixed(vv, 1, 1);                         (* climb *)
          WrStr("m/s ");
--        IF tok THEN WrStr(" "); WrFixed(rt, 1, 1); WrStr("C") END;
          WrStr("a1="); WrInt(m10rcard(rxbuf, 2, 2), 1); 
          WrStr(" a2="); WrInt(m10rcard(rxbuf, 4, 2), 1);
          WrStr(" a3="); WrInt(m10rcard(rxbuf, 6, 2), 1);
          WrStr(" c2="); WrInt(m10rcard(rxbuf, 45, 2), 1);
          WrStr(" c3="); WrInt(m10rcard(rxbuf, 47, 2), 1);
          WrStr(" cr="); WrInt(m10rcard(rxbuf, CRCPOSB, 2), 1);
        END; (* verb *)

-- build tx frame
        IF txok THEN
          FOR i:=0 TO 8 DO s[i+7]:=ids[i] END;
 
          WITH chan[m] DO                                             (* call if set *)
            s[0]:=CHR(mycallc DIV (256*256*256));
            s[1]:=CHR(mycallc DIV (256*256) MOD 256);
            s[2]:=CHR(mycallc DIV (256) MOD 256);
            s[3]:=CHR(mycallc MOD 256);
            IF mycallc>0 THEN s[4]:=myssid ELSE s[4]:=CHR(16) END;
            s[5]:=0C;
            s[6]:=0C;
          END;
          FOR i:=0 TO FLEN10-1 DO s[i+16]:=rxbuf[i] END;              (* payload *)

          flen:=16+FLEN10;
          sdrparm(s, flen, m);
          alludp(chan[m].udptx, flen, s);
        END;
--build tx frame
        monitor(m, "M20", ids);
 

      ELSIF verb THEN 
        WrChan(m);
        WrStr("M20 crc error");
      END;
 
      setactiv(savecnt, 30);

      IF verb THEN
        WrdB(chan[m].admax-chan[m].admin);
--      WrQuali(noiselevel(bitlev, noise));
        IF repl>0 THEN WrStr(" +r");WrInt(repl, 1);WrStr("/");WrInt(repairstep, 1); END;
--      Wrtune(chan[m].admax+chan[m].admin, chan[m].admax-chan[m].admin);
        appendsdr(m);
      END;

      IF verb2 THEN
(*
        FOR i:=0 TO 23 DO
          IF i MOD 10=0 THEN WrStrLn("") END;
          WrInt(m10card(rxbuf, 48+i*2, 2), 6); WrStr(" ");
        END;
*)

        tab:=0;
        FOR i:=0 TO frl-1 DO
          IF alternativ OR NOT (i IN HSET) (*&  (tset[i]<256)*) THEN
            IF tab MOD 12=0 THEN WrStrLn("") END;
            WrInt(i,3);WrStr(":");WrHex(m10card(rxbuf, i, 1), 3); INC(tab);
          END;
        END;
      END;
      IF verb THEN WrStrLn("") END;
    END;  (* min framelen *)
  END;
END decodeframe20;


PROCEDURE demodbyte10(m:CARDINAL; d:BOOLEAN);
BEGIN
  WITH chan[m].m10 DO

--WrInt(ORD(d),1); 
--WrInt(rxp, 4); WrStrLn("");
    synword1:=synword1*2 + ORD(CAST(SET32, synword)*SET32{23}<>SET32{});
    synword:=synword*2 + ORD(d);
    IF rxp>=FLEN10 THEN 
      IF CAST(SET32, synword1)*SET32{0..2,6..15}=SET32{6,7} THEN               (* unique frame sync *)
--WrStr(" -fsyn- "); WrHex(synword>>12, 3); WrHex(synword>>8, 3);WrHex(synword, 3); WrStrLn("");
        IF CAST(SET32, synword)*SET32{0..23}=CAST(SET32, M10SYN) THEN
          rxp:=3;
          alternativ:=FALSE;
          ism20:=FALSE;
--WrStr(" -syn- "); WrHex(synword1 DIV 256, 10); WrHex(synword1, 15);
        ELSIF CAST(SET32, synword)*SET32{4..23}=CAST(SET32, M10SYN1) THEN
          rxp:=3;
          alternativ:=TRUE;
          ism20:=FALSE;
--WrStr(" -syn1- ");
        ELSIF CAST(SET32, synword)*SET32{8..23}=CAST(SET32, M20ASYN) THEN
          rxp:=3;
          alternativ:=FALSE;
          ism20:=TRUE;
--WrStr(" -syn20- ");
        END;
        IF rxp=3 THEN
          rxb:=0;
          rxbuf[0]:=CHR(synword/10000H);
          rxbuf[1]:=CHR(synword/100H MOD 100H);
          rxbuf[2]:=CHR(synword MOD 100H);
          chan[m].framestarttime:=time();
        END;
      END;

    ELSE 
      INC(rxb);
      IF rxb>=8 THEN      
        rxbuf[rxp]:=CHR(synword MOD 100H);
        rxb:=0;
        INC(rxp);
        IF ism20 THEN
          IF rxp=FLEN20 THEN
            IF chan[m].framestarttime+FRAMELIFETIME>=time() THEN decodeframe20(m) END;
            rxp:=FLEN10;                                              (* start new frame hunt *)
          END;
        ELSIF (rxp=FLEN10) & (chan[m].framestarttime+FRAMELIFETIME>=time()) THEN decodeframe10(m) END;
      END;
    END; 
  END;

END demodbyte10;

PROCEDURE demodbit10(m:CARDINAL; u:REAL);
VAR d, bit:BOOLEAN;
    ua:REAL;
BEGIN

  d:=u>=0.0;
  WITH chan[m].m10 DO
    IF lastmanch=d THEN INC(manchestd, (32767-manchestd) DIV 16) END;

    bit:=d<>lastmanch;
    IF (manchestd>0) THEN
      demodbyte10(m, bit); 

(*quality*)
      ua:=ABS(u)-bitlev;
      bitlev:=bitlev + ua*0.02;
      noise:=noise + (ABS(ua)-noise)*0.05;
(*quality*)

    END;
    lastmanch:=d;
    manchestd:=-manchestd;
  END;
END demodbit10;


PROCEDURE demod10(u:REAL; m:CARDINAL);
VAR d:BOOLEAN;
BEGIN
(*
  IF debfd>=0 THEN
    ui:=VAL(INTEGER, u*0.002);
    WrBin(debfd, ui, 2);
  END;
*)
  WITH chan[m].m10 DO
    d:=u>=0.0;
    IF cbit THEN
      demodbit10(m, u);
      IF d<>oldd THEN

        IF d=plld THEN INC(baudfine, pllshift) ELSE DEC(baudfine, pllshift) END;

        oldd:=d;
      END;
    ELSE plld:=d END;
    cbit:=NOT cbit;
  END;

END demod10;


PROCEDURE Fsk10(m:CARDINAL);
VAR ff:REAL;
    lim:INTEGER;
BEGIN
  WITH chan[m].m10 DO
    lim:=demodbaud;
    LOOP
      IF baudfine>=BAUDSAMP THEN
        DEC(baudfine, BAUDSAMP);
        ff:=Fir(afin, baudfine MOD BAUDSAMP DIV (BAUDSAMP DIV AOVERSAMP),
        AOVERSAMP, chan[m].afir, afirtab);
        demod10(ff, m);
      END;
      INC(baudfine, lim);
      lim:=0;
      IF baudfine<BAUDSAMP*2 THEN EXIT END;

    END;
  END;
END Fsk10;


------------------------ IMET


PROCEDURE decodeframeimet(m:CARDINAL);
CONST POLY=1021H;
      NAMECHECKS=3;

VAR p, i, j, len, gpstime, ii, frnum, flen:CARDINAL;
    st:TIME;
    crc:SET16;
    typ:CHAR;
    vx, vy, dir, lat, long:REAL;
    crcok, lfdone, posok:BOOLEAN;
    name:ARRAY[0..8] OF CHAR;
    s:ARRAY[0..200] OF CHAR;
BEGIN
  FILL(ADR(name), 0C, SIZE(name));
  posok:=FALSE;
  lfdone:=TRUE;
  p:=0;
  WITH chan[m].imeta DO
    WITH chan[m].nonames^.imet DO
      IF (idnew<>0) & (idcnt>NAMECHECKS) THEN                                 (* name ok *)
        name:="IMET";
        IntToStr(idnew, 1, s);
        Append(name, s);
      END; 
    END; 
    frnum:=MAX(CARDINAL);
    gpstime:=MAX(CARDINAL); 
    LOOP
      IF p+2>HIGH(rxbuf) THEN EXIT END;
 
      typ:=rxbuf[p+1];                                               (* frame type *)
      CASE typ OF
        1C: len:=12;
       |2C: len:=18; 
       |3C: len:=5+ORD(rxbuf[p+2]); 
       |4C: len:=20;
       |5C: len:=30;
      ELSE len:=0 END;
      IF (len<=2) OR (p+len>rxp) THEN EXIT END;                      (* no known frame *)

      IF verb THEN
        IF lfdone THEN
          WrChan(m);
          WrStr("iMET ");
          IF name[0]=0C THEN WrStr("idchk:"); WrInt(chan[m].nonames^.imet.idcnt, 1);
          ELSE WrStr(name) END;
--          WrStr(" ");
          WrdB(chan[m].admax-chan[m].admin);
          WrQuali(noiselevel(bitlev, noise));
          lfdone:=FALSE;
        END;
        WrStr(" <"); WrStr(CHR(ORD(typ)+ORD("0"))); WrStr(">");
      END;
      setactiv(savecnt, 30);
-- crc
      crc:=SET16(1D0FH);
      FOR i:=0 TO len-3 DO
        crc:=crc/SHIFT(CAST(SET16, ORD(rxbuf[p+i])), 8);
        FOR j:=0 TO 7 DO
          IF 15 IN crc THEN crc:=SHIFT(crc,1)/SET16(POLY) ELSE crc:=SHIFT(crc,1) END;
        END;
      END;
-- crc

      crcok:=crc=CAST(SET16, ORD(rxbuf[p+len-2])*256+ORD(rxbuf[p+len-1]));
      IF crcok THEN
        IF (typ=2C) OR (typ=5C) THEN                                (* gps *)
--INC(test1);
          IF typ=5C THEN ii:=25 ELSE ii:=13 END; 
          gpstime:=cardmsb(rxbuf, p+ii, 1)*3600
                 + cardmsb(rxbuf, p+ii+1, 1)*60
                 + cardmsb(rxbuf, p+ii+2, 1);                      (* raw gps time not utc *)
          lat:= SaveReal(cardmsb(rxbuf, p+2, 4));
          long:=SaveReal(cardmsb(rxbuf, p+6, 4));
          posok:=TRUE;

-- check id
          st:=time();
          WITH chan[m].nonames^.imet DO
            IF (st>=idtime) & (st-idtime>1800) THEN                 (* a while not heard *)
              idnew:=0;
              idcnt:=0;
              name[0]:=0C;
            END;
            IF ABS(lat-lastlat)+ABS(long-lastlong)>1.0 THEN         (* another region ? *)
              IF (idnew<>0) & verb THEN WrStr(" pos jump! ") END;
              idnew:=0;
              idcnt:=0;
              name[0]:=0C;
            END;
            lastlat:=lat;
            lastlong:=long;
            idtime:=st;
          END;
-- check id

          IF verb THEN
            WrFixed(lat, 5,1);
            WrStr(" ");WrFixed(long, 5,1);
            WrStr(" ");WrInt(VAL(INTEGER, cardmsb(rxbuf, p+10, 2))-5000, 1); 
            WrStr("m sats:"); WrInt(cardmsb(rxbuf, p+12, 1), 1);
            IF typ=5C THEN                                          (* gps with speeds *)
              vx:=SaveReal(cardmsb(rxbuf, p+13, 4));
              vy:=SaveReal(cardmsb(rxbuf, p+17, 4));
              dir:=atang2(vx, vy)/RAD;
              IF dir<0.0 THEN dir:=360.0+dir END;
              WrStr(" "); WrFixed(sqrt(vx*vy+vy*vy)*3.6, 2,1);
              WrStr("km/h "); WrInt(VAL(INTEGER, dir), 0);
              WrStr("deg clb:");
              WrFixed(SaveReal(cardmsb(rxbuf, p+21, 4)), 2,1);
              WrStr("m/s ");
            END;
            WrStr(" "); wrtime((DAYSEC+gpstime-GPSTIMECORR) MOD DAYSEC);   (* gps time not utc *)

          END;

        ELSIF (typ=1C) OR (typ=4C) THEN                             (* ptu *)
--INC(test2);
          frnum:=cardmsb(rxbuf, p+2, 2);
          IF verb THEN

            WrStr("fn:"); WrInt(frnum, 1);
            WrStr(" ");WrFixed(FLOAT(cardmsb(rxbuf, p+4, 3))*0.01, 2,1);
            WrStr("hPa ");WrFixed(VAL(REAL, CAST(INT16, cardmsb(rxbuf, p+7, 2)))*0.01, 2,1);
            WrStr("C ");WrFixed(FLOAT(cardmsb(rxbuf, p+9, 2))*0.01, 2,1);
            WrStr("% Vb:");WrFixed(FLOAT(cardmsb(rxbuf, p+11, 1))*0.1, 1,1);
            IF typ=4C THEN                                          (* extended ptu *)
              WrStr(" ti:");WrFixed(VAL(REAL, CAST(INT16, cardmsb(rxbuf, p+12, 2)))*0.01, 2,1);
              WrStr(" tp:");WrFixed(VAL(REAL, CAST(INT16, cardmsb(rxbuf, p+14, 2)))*0.01, 2,1);
              WrStr(" tu:");WrFixed(VAL(REAL, CAST(INT16, cardmsb(rxbuf, p+16, 2)))*0.01, 2,1);
            END;
          END;
          
        ELSIF typ=3C THEN                                           (* extensions *)
          IF len=13 THEN                                            (* may be ozone *)
            IF verb THEN
              WrStr(" otyp:"); WrInt(cardmsb(rxbuf, p+3, 1), 1);
              WrStr(" onum:"); WrInt(cardmsb(rxbuf, p+4, 1), 1);
              WrStr(" oi:");  WrFixed(FLOAT(cardmsb(rxbuf, p+5, 2))*0.001, 3,1);
              WrStr("uA to:");  WrFixed(FLOAT(cardmsb(rxbuf, p+7, 2))*0.01, 2,1);
              WrStr("C Pump:"); WrInt(cardmsb(rxbuf, p+9, 1), 1);
              WrStr("mA VP:");  WrFixed(FLOAT(cardmsb(rxbuf, p+10, 1))*0.1, 1,1);
              WrStr("V ");
            END;
          ELSE                                                      (* unknown extension *)
            IF verb THEN
              WrStr("unknown extension frame [");
              i:=0;
              LOOP
                IF i+3>len THEN WrStr("] "); EXIT END;

                WrHex(ORD(rxbuf[p+i]), 3);
                INC(i); 
                IF (i MOD 16=15) & (i+3<len) THEN WrStrLn("") END;
              END; 
            END; 
          END;
        END;
      ELSIF verb THEN WrStr("crc err ") END;

      INC(p, len);
    END;

--WrInt(test1, 6); WrInt(test2, 6); WrStrLn(" testcnt");

    IF (frnum<65536) & (gpstime<86400) THEN       (* try build serial no *)
      i:=10000 + (gpstime+86400-frnum) MOD 86400; (* gpstime - framenum *)
      WITH chan[m].nonames^.imet DO
        IF i=idnew THEN INC(idcnt) ELSE idcnt:=0 END; 
        IF idnew=0 THEN idnew:=i END;
      END;
    END;

    IF verb & NOT lfdone THEN WrStrLn("") END;

    IF posok & (name[0]<>0C) THEN
      FILL(ADR(s), 0C, SIZE(s));                                    (* end of block is 0 *)                         
      FOR i:=0 TO 8 DO s[i+7]:=name[i] END;
      WITH chan[m] DO                                               (* call if set *)
        s[0]:=CHR(mycallc DIV (256*256*256));
        s[1]:=CHR(mycallc DIV (256*256) MOD 256);
        s[2]:=CHR(mycallc DIV (256) MOD 256);
        s[3]:=CHR(mycallc MOD 256);
        IF mycallc>0 THEN s[4]:=myssid ELSE s[4]:=CHR(16) END;
        s[5]:=0C;
        s[6]:=0C;
      END;
      FOR i:=0 TO FLENIMET-1 DO s[i+16]:=rxbuf[i] END;              (* payload *)

      flen:=16+FLENIMET;
      sdrparm(s, flen, m);
      alludp(chan[m].udptx, flen, s);
    END;
    monitor(m, "IMET", name);

  END;
END decodeframeimet;

PROCEDURE demodbitimet(m:CARDINAL; d:BOOLEAN);
BEGIN
  WITH chan[m].imeta DO
    IF d THEN stopc:=0 ELSE INC(stopc) END;
    IF stopc>20 THEN                            (* a while stop steps is end of frame, more time avoids decode frames out of noise *)
      IF (rxp>=12) & (rxp<HIGH(rxbuf)) THEN decodeframeimet(m) END;
      rxp:=0;
      rxbitc:=0;
    ELSE
      INC(rxbitc);
      rxbyte:=rxbyte DIV 2;
      IF NOT d THEN INC(rxbyte, 256) END;
      IF rxbitc>=10 THEN
        IF ((rxp<>0) OR (rxbyte=257)) & (rxp<=HIGH(rxbuf)) THEN  (* x01 is start of frame *)
          rxbuf[rxp]:=CHR(rxbyte MOD 256);
          INC(rxp);
        END;
        rxbitc:=0;
      END;
    END;

-- IF d THEN WrStr("0") ELSE WrStr("1") END;

  END;
END demodbitimet;


PROCEDURE demodimet(u:REAL; channel:CARDINAL);
VAR d:BOOLEAN;
    ua :REAL;
BEGIN
  d:=u>=0.0;
  WITH chan[channel].imeta DO
    IF cbit THEN
      demodbitimet(channel, d);
      IF d<>oldd THEN
        IF stopc=0 THEN        (* fast dpll lock on byte start, less than ideal solution for phase jump on asynchron bytes *)
          IF  d=plld THEN INC(baudfine, pllshift*3) ELSE DEC(baudfine, pllshift*3) END;
        ELSIF d=plld THEN INC(baudfine, pllshift) ELSE DEC(baudfine, pllshift) END;
        oldd:=d;
      END;

(*quality*)
      ua:=ABS(u)-bitlev;
      bitlev:=bitlev + ua*0.02;
      noise:=noise + (ABS(ua)-noise)*0.05;
(*quality*)

    ELSE plld:=d END;
    cbit:=NOT cbit;
  END;
END demodimet;


PROCEDURE Afsk202(channel:CARDINAL);
VAR right, mid, d, a, b, ff:REAL;
BEGIN
  WITH chan[channel].imeta DO
    right:=Fir(afin, 0, AOVERSAMP, chan[channel].afir, afirtab);
    IF (left<0.0)<>(right<0.0) THEN
      d:=left/(left-right);
      a:=FLOAT(TRUNC(d*FLOAT(AOVERSAMP)+0.5));
      b:=a * (1.0/FLOAT(AOVERSAMP));
      IF (TRUNC(a)>0) & (TRUNC(a)<AOVERSAMP) THEN
        mid:=Fir(afin, AOVERSAMP-TRUNC(a), AOVERSAMP, chan[channel].afir, afirtab);
        IF (left<0.0)<>(mid<0.0) THEN d:=left/(left-mid)*b;
        ELSE d:=b + mid/(mid-right)*(1.0-b) END;
      END;
      IF tcnt+d<>0.0 THEN freq:=1.0/(tcnt+d) END;
      tcnt:=0.0-d;
    END;

    tcnt:=tcnt+1.0;
    left:=right;
    dfir[dfin]:=freq - afskmidfreq;
    dfin:=(dfin+1) MOD DFIRLEN;
    INC(baudfine, demodbaud);
    IF baudfine>=BAUDSAMP THEN
      DEC(baudfine, BAUDSAMP);
      IF baudfine<BAUDSAMP THEN       (* normal alway true *)
        ff:=Fir(dfin, DOVERSAMP - baudfine DIV (BAUDSAMP DIV DOVERSAMP), DOVERSAMP, dfir, dfirtab);
        demodimet(ff, channel);
      END;
    END;
  END;
END Afsk202;


------------------------ MEISEI (share demod with MRZ *)

CONST SYNWORDMEIS1=CAST(SET32,0049DCEH);
      SYNWORDMEIS2=CAST(SET32,0FB6230H);

---bch

PROCEDURE checkbch(bb-:ARRAY OF BOOLEAN; start:CARDINAL):BOOLEAN; (* use bch as 12bit crc *)
CONST P=SET16{0,3,4,5,8,10,12};
VAR i:CARDINAL;
    s:SET16;
BEGIN
  s:=SET16{};
  FOR i:=0 TO 33 DO
    s:=SHIFT(s,1);
    IF (12 IN s)<>((i<34) & (bb[start+i])) THEN s:=s/P END;
  END;
  FOR i:=0 TO 11 DO 
    IF bb[start+45-i]<>(i IN s) THEN RETURN FALSE END;
  END;
  RETURN TRUE
END checkbch;

PROCEDURE bchcorr1(VAR bb:ARRAY OF BOOLEAN; start:CARDINAL):INTEGER;  (* correct 0..1 bit *)
VAR i:CARDINAL;
BEGIN
  IF checkbch(bb, start) THEN RETURN 0 END;

  FOR i:=0 TO 33 DO
    bb[start+i]:=NOT bb[start+i];
    IF checkbch(bb, start) THEN RETURN 1 END;

    bb[start+i]:=NOT bb[start+i];
  END;
  RETURN -1
END bchcorr1;

PROCEDURE bchcorr2(VAR bb:ARRAY OF BOOLEAN; start:CARDINAL):INTEGER;  (* correct 0..2 bit *)
VAR i,j:CARDINAL;
BEGIN
  IF checkbch(bb, start) THEN RETURN 0 END;

  FOR i:=0 TO 33 DO
    bb[start+i]:=NOT bb[start+i];
    IF checkbch(bb, start) THEN RETURN 1 END;

    FOR j:=i+1 TO 33 DO
      bb[start+j]:=NOT bb[start+j];
      IF checkbch(bb, start) THEN RETURN 2 END;

      bb[start+j]:=NOT bb[start+j];
    END;

    bb[start+i]:=NOT bb[start+i];
  END;
  RETURN -1
END bchcorr2;

---bch

PROCEDURE meisname(n:CARDINAL; VAR s:ARRAY OF CHAR);
VAR sn:REAL;
    i:CARDINAL;
BEGIN
  FOR i:=0 TO HIGH(s) DO s[i]:=0C END;
  sn:=SaveReal(n);
  IF (sn>=1.0) & (sn<=FLOAT(0FFFFFFH)) THEN
    n:=TRUNC(sn+0.5) MOD 1000000H;
    Assign(s, "IMS");
    FOR i:=8 TO 3 BY -1 DO
      IF i<=HIGH(s) THEN s[i]:=hex(n) END;
      n:=n DIV 16;
    END;
  END;
END meisname;
    
PROCEDURE meisdate(d, t:CARDINAL):TIME;
VAR s:ARRAY[0..20] OF CHAR;
    n:CARDINAL;
BEGIN
  s:="....-..-.. 00:00:00";
  n:=2020+d MOD 10;                                   (* has to be updated every decade *)
  s[0]:=CHR(n DIV 1000+ORD("0"));
  s[1]:=CHR(n DIV 100 MOD 10+ORD("0"));
  s[2]:=CHR(n DIV 10 MOD 10+ORD("0"));
  s[3]:=CHR(n MOD 10+ORD("0"));
  n:=d DIV 10 MOD 100;
  s[5]:=CHR(n DIV 10+ORD("0"));
  s[6]:=CHR(n MOD 10+ORD("0"));
  n:=d DIV 1000 MOD 100;
  s[8]:=CHR(n DIV 10+ORD("0"));
  s[9]:=CHR(n MOD 10+ORD("0"));
  IF StrToTime(s, n) THEN
    INC(n, t);                                        (* add daytime to date *)
--    t:=(t+(DAYSEC-GPSTIMECORR)) MOD DAYSEC;
  ELSE n:=0 END;
  RETURN n
END meisdate;


PROCEDURE decodemeisei(m:CARDINAL);
CONST IMS=0C1H;
      RS11=0A2H;
      TYPDISC=0C0H;
      IDTIME=60*3;  (* stop send if not got actual serial *)
      NOJUNK=4;     (* min blocks correct to show frame *)
      AKTIVJUNK=6;   (* min blocks correct to stay awake *)

VAR i,j,b,c,bk,bp,date,fcnt,fnum,datetime,cfg,cf:CARDINAL;
    t:TIME;
    ret:INTEGER;
    dg:LONGREAL;
    okbits:SET8;
    bb:ARRAY[0..23] OF CARD8;
    blockok:ARRAY[0..5] OF INT8;
    sumok, nameok, joined, verb1:BOOLEAN;
    s:ARRAY[0..200] OF CHAR;
    name:ARRAY[0..20] OF CHAR;
BEGIN
  WITH chan[m].meisei DO
    sumok:=FALSE;
    nameok:=FALSE;
    date:=0;
    bp:=0;
    FOR bk:=0 TO 5 DO                                          (* extract databytes *)
--    IF checkbch(rxbuf, bk*46) THEN INCL(blockok, bk) END;    (* as not found a crc use bch as a 12 bit crc, data correction will make too much junk *) 
      blockok[bk]:=bchcorr2(rxbuf, bk*46);                     (* try correct 0 to 2 bit *) 
      IF blockok[bk]>=0 THEN
        FOR j:=0 TO 1 DO                                       (* make 4 databytes out of 34 bits *)
          c:=0;
          b:=0;
          FOR i:=0 TO 16 DO
            INC(b,b);                                          (* check 16+1 bit patrity *)
            IF rxbuf[i+j*17+bk*46] THEN INC(b); INC(c) END; 
          END;
          b:=b DIV 2;
          bb[bp]:=b DIV 256;
          INC(bp);
          bb[bp]:=b MOD 256;
          INC(bp);
          IF NOT ODD(c) THEN blockok[bk]:=-2 END;              (* parity error *)
        END;
      END;
    END;
    okbits:=SET8{};
    j:=0;
    FOR bk:=0 TO 5 DO
      IF blockok[bk]>=2 THEN INC(j);
      ELSIF blockok[bk]>=0 THEN INC(j,2); INCL(okbits, bk) END;
    END; 
    IF j>=AKTIVJUNK THEN setactiv(chan[m].mp3h.savecnt, 30) END;
    verb1:=verb & (j>=NOJUNK) OR verb2;                              (* not show too much from noise *)
    IF lostsamps<100 THEN INCL(okbits, 7) ELSE timeok:=FALSE END;    (* 24 is synword *)
    lostsamps:=0;
    
    IF verb1 THEN 
      IF (ser[0]>0C) & (lastser+120>=time()) THEN WrStr(ser) ELSE WrStr("Meisei") END;
      WrStr(" ");
      FOR i:=0 TO 5 DO
        IF blockok[i]=0 THEN WrStr("+");
        ELSIF blockok[i]=1 THEN WrStr("1");
        ELSIF blockok[i]=2 THEN WrStr("2");
        ELSIF blockok[i]=-1 THEN WrStr("-");
        ELSE WrStr("!") END;
      END;
      IF verb2 THEN
        WrStrLn("");
        WrStr("[");
        FOR i:=0 TO 23 DO WrStr(" "); WrHex(bb[i],1) END;
        WrStrLn("]");
      END;
    END;

    IF frametyp=1 THEN
      IF blockok[0]>=0 THEN
        date:=VAL(CARDINAL,bb[0])*256+VAL(CARDINAL,bb[1]);
        IF date=0 THEN frametyp:=3 END;                         (* ??? *)
        IF frametyp=1 THEN
          IF timeok THEN
            FOR i:=0 TO 10 DO INC(gpssum, VAL(CARDINAL,bb[i*2])*256+VAL(CARDINAL,bb[i*2+1])) END;
            sumok:=gpssum MOD 10000H=VAL(CARDINAL,bb[22])*256 + VAL(CARDINAL,bb[23]);
            IF sumok THEN gpstime:=meisdate(date, gpsdaytime) END; 
          END;
          IF verb1 THEN
            WrStr("B"); WrInt(subtype,1);
            IF NOT sumok THEN WrStr(" chksum-err") END;
            WrStr(" "); WrInt(2020+date MOD 10,1); WrStr("-");
            WrInt(date DIV 10 MOD 100,1); WrStr("-");
            WrInt(date DIV 1000,1);

            IF blockok[1]>=0 THEN
              j:=0;
              FOR i:=0 TO 3 DO j:=j*256+VAL(CARDINAL,bb[i+2]) END;
              IF subtype=1 THEN dg:=LFLOAT(j DIV 1000000) + LFLOAT(j MOD 1000000)*(0.00001/6.0);
              ELSE dg:=LFLOAT(j)*(0.0000001); END;
              WrStr(" lat:");WrFixed(dg,5,1);
             END;

            IF (blockok[1]>=0) & (blockok[2]>=0)  THEN
              j:=0;
              FOR i:=0 TO 3 DO j:=j*256+VAL(CARDINAL,bb[i+6]) END;
              IF subtype=1 THEN dg:=LFLOAT(j DIV 1000000) + LFLOAT(j MOD 1000000)*(0.00001/6.0);
              ELSE dg:=LFLOAT(j)*(0.0000001); END;
              WrStr(" long:"); WrFixed(dg,5,1);  
            END;

            IF (blockok[2]>=0) & (blockok[3]>=0) THEN
              j:=0;
              IF subtype=1 THEN 
                FOR i:=0 TO 2 DO j:=j*256+VAL(CARDINAL,bb[i+10]) END;
              ELSE
                FOR i:=0 TO 3 DO j:=j*256+VAL(CARDINAL,bb[i+10]) END;
              END;
              dg:=LFLOAT(j)*0.01;
              WrStr(" alt:");WrFixed(dg,1,1);
            END;

            IF (subtype=1) & (blockok[3]>=0) & (blockok[4]>=0) THEN
              IF verb2 THEN 
                WrStr(" [");
                FOR i:=13 TO 17 DO WrHex(bb[i],1) END; 
                WrStr("]");
              END;
            END;

            IF blockok[4]>=0 THEN
              IF subtype=1 THEN
                dg:=LFLOAT(VAL(CARDINAL,bb[18])*256+VAL(CARDINAL,bb[19]))*0.01;
              ELSE
                dg:=LFLOAT(VAL(CARDINAL,bb[16])*256+VAL(CARDINAL,bb[17]))*0.01;
              END;
              WrStr(" dir:");WrFixed(dg,1,1);
            END;

            IF subtype=1 THEN
              IF blockok[5]>=0 THEN
                dg:=LFLOAT(VAL(CARDINAL,bb[20])*256+VAL(CARDINAL,bb[21]))*(0.01*1.851984);
                WrStr(" kmh:");WrFixed(dg,2,1);
              END;
            ELSIF blockok[4]>=0 THEN
              dg:=LFLOAT(VAL(CARDINAL,bb[14])*256+VAL(CARDINAL,bb[15]))*0.01;
              WrStr(" kmh:");WrFixed(dg,2,1);
            END;

            IF (subtype<>1) & (blockok[4]>=0) THEN
              dg:=VAL(LONGREAL,VAL(INTEGER, VAL(CARDINAL,bb[18])*256+VAL(CARDINAL,bb[19])))*0.01;
              WrStr(" clb:");WrFixed(dg,2,1);
            END;

          END;

        ELSE 
          timeok:=FALSE;
          IF verb1 THEN WrStr("D"); WrInt(subtype,1) END;
        END; 
      ELSE
        timeok:=FALSE;
        IF verb1 THEN WrStr("  ") END;
      END;
    ELSE                                                       (* frametyp 0,2 *)
      timeok:=FALSE;
      gpssum:=VAL(CARDINAL,bb[20])*256 + VAL(CARDINAL,bb[21])
             +VAL(CARDINAL,bb[22])*256 + VAL(CARDINAL,bb[23]);

      IF blockok[0]>=0 THEN
        fcnt:=VAL(CARDINAL,bb[0])*256+VAL(CARDINAL,bb[1]);
        IF ODD(fcnt) THEN frametyp:=2 END;
        fnum:=fcnt DIV 2;

        IF verb1 THEN
          IF frametyp=2 THEN WrStr("C") ELSE WrStr("A") END; 
          WrInt(subtype,1);
          WrStr(" fn:"); WrInt(fnum,1);
        END; 
        IF (blockok[3]>=0) & (bb[14]=30H+ORD(frametyp=2)) THEN
          subtype:=1+ORD(bb[15]<=TYPDISC);
          IF verb1 THEN
            IF subtype=1 THEN WrStr(" ims100");
            ELSE WrStr(" "); WrHex(bb[15], 1); WrStr("=type?") END;
          END; 
        END;

        IF (subtype=1) & (blockok[1]>=0) THEN
          cf:=VAL(CARDINAL,bb[4])*256 + VAL(CARDINAL,bb[5])
            +VAL(CARDINAL,bb[6])*(256*256*256) + VAL(CARDINAL,bb[7])*(256*256);
          cfg:=fcnt MOD 64 + 64*ORD(frametyp=2);
          config[cfg].d:=cf;
          config[cfg].t:=time();
          IF verb1 THEN
            WrStr(" calib["); WrInt(cfg, 1);
            WrStr("]:");
            j:=cf; 
            FOR i:=0 TO 3 DO WrHex(ASH(j,-24),0); j:=ASH(j,8) END;
          END;
          IF (cfg=0) OR (cfg=16) OR (cfg=32) OR (cfg=48) THEN meisname(cf, ser);
            IF verb1 THEN WrStr(" ser:"); WrStr(ser); END;
            lastser:=time();
          ELSIF cfg=64+15 THEN
            IF verb1 THEN WrStr(" MHz:"); WrFixed(400.0+SaveReal(cf)*0.1,2,1); END;
          END;

        END;

        IF (blockok[5]>=0) & (frametyp=0) THEN
          gpsdaytime:=(VAL(CARDINAL,bb[20])*256+VAL(CARDINAL,bb[21])) DIV 1000
                 + VAL(CARDINAL,bb[22])*3600 + VAL(CARDINAL,bb[23])*60;
          timeok:=gpsdaytime<3600*24;  
          IF verb1 THEN WrStr(" "); wrtime(gpsdaytime); END; 
        END;
        
      ELSIF verb1 THEN WrStr("  ") END; 
    END;
    IF verb1 THEN 
      WrdB(chan[m].admax-chan[m].admin);
      WrQuali(noiselevel(chan[m].mp3h.bitlev, chan[m].mp3h.noise));
      WrStrLn("");
    END;

---check name
    IF subtype=1 THEN
      t:=time();
      j:=0;
      b:=0;
      FOR i:=0 TO 48 BY 16 DO
        IF (config[i].t+IDTIME>=t) & (config[i].d<>0) THEN
          IF b=0 THEN b:=config[i].d; INC(j);               (* count same actual ser *)
          ELSIF b=config[i].d THEN INC(j) END;
        END;
      END;
  
      IF j>=2 THEN                                          (* found 2 ident ser *)
        meisname(b, name);
        IF Length(name)>=5 THEN nameok:=TRUE END;
      END;
    END;
---check name


    IF nameok & (chan[m].framestarttime+FRAMELIFETIME>=time()) THEN
      monitor(m, "MEIS", name);
      FILL(ADR(s), 0C, SIZE(s));                                    (* end of block is 0 *)
      FOR i:=0 TO 8 DO s[i+7]:=name[i] END;
      WITH chan[m] DO                                               (* call if set *)
        s[0]:=CHR(mycallc DIV (256*256*256));
        s[1]:=CHR(mycallc DIV (256*256) MOD 256);
        s[2]:=CHR(mycallc DIV (256) MOD 256);
        s[3]:=CHR(mycallc MOD 256);
        IF mycallc>0 THEN s[4]:=myssid ELSE s[4]:=CHR(16) END;
        s[5]:=0C;
        s[6]:=0C;
      END;
      s[16]:=CHR(ASH(gpstime,-24));
      s[17]:=CHR(ASH(gpstime,-16));
      s[18]:=CHR(ASH(gpstime,-8));
      s[19]:=CHR(gpstime);
      s[20]:=CHR(okbits);  

      IF ODD(frametyp) THEN
        s[21]:=CHR(SHIFT(SYNWORDMEIS2,-16)); 
        s[22]:=CHR(SHIFT(SYNWORDMEIS2,-8));
        s[23]:=CHR(SYNWORDMEIS2);
      ELSE
        s[21]:=CHR(SHIFT(SYNWORDMEIS1,-16));
        s[22]:=CHR(SHIFT(SYNWORDMEIS1,-8));
        s[23]:=CHR(SYNWORDMEIS1);
      END;
      FOR i:=0 TO 6*4-1 DO s[24+i]:=CHR(bb[i]) END;
      i:=21+FLENMEISEI;
      sdrparm(s, i, m);
      alludp(chan[m].udptx, i, s);
  
    END;
  END;
END decodemeisei;

PROCEDURE demodbytemeisei(m:CARDINAL; d:BOOLEAN);
CONST MAXERR=2;                                       (* allow wrong bits in sync word *)

  PROCEDURE cmpsyn(w,s:SET32):BOOLEAN;
  VAR i,j:CARDINAL;
  BEGIN
    w:=w*SET32{0..23}/s;
    j:=0;
    FOR i:=0 TO 23 DO
      IF i IN w THEN               (* wrong bit *)
        INC(j);
        IF j>MAXERR THEN RETURN FALSE END;

      END;
    END; 
    RETURN TRUE;   
  END cmpsyn;

BEGIN
  WITH chan[m].meisei DO
--  IF chan[m].mp3h.savecnt>0 THEN
      INC(synword, synword + ORD(d));
      IF rxb>=FLENMEISEIRAW THEN                                    (* out of frame *)
        INC(lostsamps);                                             (* check for time frame fits to date *)
        IF cmpsyn(CAST(SET32, synword), SYNWORDMEIS1) THEN
          rxb:=0;
          chan[m].framestarttime:=time();
          chan[m].meisei.frametyp:=0;
        ELSIF cmpsyn(CAST(SET32, synword), SYNWORDMEIS2) THEN
          rxb:=0;
          chan[m].framestarttime:=time();
          chan[m].meisei.frametyp:=1;
        END;
      ELSE
        rxbuf[rxb]:=d;
        INC(rxb);
        IF rxb=FLENMEISEIRAW THEN decodemeisei(m) END;              (* frame full *)
      END;
--  END;
  END;
END demodbytemeisei;


------------------------ MRZ MP3-H1 (share demod with Meisei)

PROCEDURE cint16(v:INTEGER):INTEGER;
BEGIN
  IF v>32767 THEN DEC(v, 65536) END;
  RETURN v 
END cint16;

PROCEDURE Whex(n:CARDINAL);
VAR s:ARRAY[0..3] OF CHAR;
BEGIN
  s[0]:=hex(n DIV 4096);
  s[1]:=hex(n DIV 256);
  s[2]:=hex(n DIV 16);
  s[3]:=hex(n);
  WrStr(s);
END Whex;

PROCEDURE crcmp3(b-:ARRAY OF CHAR; from, to:CARDINAL):BOOLEAN;
CONST POLY=0A001H;
VAR i,j:CARDINAL;
    c:SET16;
BEGIN
  c:=SET16(0FFFFH);
  FOR i:=from TO to-1 DO
    c:=c/CAST(SET16, ORD(b[i]));
    FOR j:=0 TO 7 DO
      IF 0 IN c THEN c:=SHIFT(c,-1)/SET16(POLY) ELSE c:=SHIFT(c,-1) END;
    END;
  END;
  RETURN c=CAST(SET16, cardmsb(b, to, 2))
END crcmp3;

PROCEDURE mp3id(m:CARDINAL; ser:BOOLEAN; VAR id:ARRAY OF CHAR);
VAR s:ARRAY[0..20] OF CHAR;
    n:CARDINAL;
BEGIN
  id[0]:=0C;
  WITH chan[m].mp3h DO
    IF id1ok & id2ok THEN
      IF ser THEN
--serial
        Assign(id, "MRZ-");
        CardToStr(id1,1,s);
        Append(id,s);
        Append(id,"-");
        CardToStr(id2,1,s);
      ELSE
--aprs
        Assign(id, "MRZ");
        n:=id1*100000+id2;
        s[0]:=hex(n DIV 100000H);
        s[1]:=hex(n DIV 10000H);
        s[2]:=hex(n DIV 1000H);
        s[3]:=hex(n DIV 100H);
        s[4]:=hex(n DIV 10H);
        s[5]:=hex(n);
        s[6]:=0C;
      END;
      Append(id,s);
    END;
  END;
END mp3id;


PROCEDURE mp3time(b:ARRAY OF CHAR):TIME;
BEGIN
  RETURN cardmsb(b,1,1)*3600+cardmsb(b,2,1)*60+cardmsb(b,3,1)
END mp3time;

PROCEDURE mp3date(d:CARDINAL; timedate, t:TIME):TIME;
VAR s:ARRAY[0..20] OF CHAR;
    n:CARDINAL;
BEGIN
  s:="....-..-.. 00:00:00";
  n:=2000+d MOD 100;
  s[0]:=CHR(n DIV 1000+ORD("0"));
  s[1]:=CHR(n DIV 100 MOD 10+ORD("0"));
  s[2]:=CHR(n DIV 10 MOD 10+ORD("0"));
  s[3]:=CHR(n MOD 10+ORD("0"));
  n:=d DIV 100 MOD 100;
  s[5]:=CHR(n DIV 10+ORD("0"));
  s[6]:=CHR(n MOD 10+ORD("0"));
  n:=d DIV 10000 MOD 100;
  s[8]:=CHR(n DIV 10+ORD("0"));
  s[9]:=CHR(n MOD 10+ORD("0"));
  IF StrToTime(s, n) THEN
    INC(n, t);                                        (* add daytime to date *)
    IF t<timedate THEN INC(n, 60*60*24) END;          (* next day but no new date received *)
    t:=(t+(DAYSEC-GPSTIMECORR)) MOD DAYSEC;
  ELSE n:=0 END;
  RETURN n
END mp3date;


PROCEDURE showmp3(m:CARDINAL; state:CARDINAL; repaired:CARDINAL; rxbuf-:ARRAY OF CHAR);
VAR i, cfg, cnt:CARDINAL;
    wx,wy,wz,vx,vy,vz, lat, long, heig, kmh, dir, clb:LONGREAL;
    done:BOOLEAN;
    s:ARRAY[0..20] OF CHAR;
BEGIN
  done:=FALSE;
  cnt:=cardmsb(rxbuf, 0, 1) MOD 16;
  IF state=1 THEN              (* crc good *)
    WrChan(m);
    WrStr("MRZ ");
    WrInt(cnt, 2); WrStr(" ");

    mp3id(m, FALSE, s); IF s[0]<>0C THEN WrStr(s); WrStr(" "); END;

    IF chan[m].mp3h.gpstime>0 THEN DateToStr(chan[m].mp3h.gpstime, s);  WrStr(s); WrStr(" ") END;

    wx:=VAL(LONGREAL, VAL(INTEGER, cardmsb(rxbuf, 5, 4)))*0.01;
    wy:=VAL(LONGREAL, VAL(INTEGER, cardmsb(rxbuf, 9, 4)))*0.01;
    wz:=VAL(LONGREAL, VAL(INTEGER, cardmsb(rxbuf, 13, 4)))*0.01;
    vx:=VAL(LONGREAL, cint16(cardmsb(rxbuf, 17, 2)))*0.01;
    vy:=VAL(LONGREAL, cint16(cardmsb(rxbuf, 19, 2)))*0.01;
    vz:=VAL(LONGREAL, cint16(cardmsb(rxbuf, 21, 2)))*0.01;

    wgs84r(wx,wy,wz, lat, long, heig);
    WrFixed(lat/RAD, 5,1);
    WrStr(" "); WrFixed(long/RAD, 5,1);
    IF (heig<100000.0) & (heig>-100000.0) THEN
      WrStr(" "); WrInt(VAL(INTEGER, heig), 1); WrStr("m");
    END;

    speeddir(lat, long, vx,vy,vz, kmh, dir, clb);
    WrStr(" "); WrFixed(kmh, 1,1); WrStr("km/h ");
    WrInt(VAL(INTEGER, dir), 1); WrStr("deg ");
    WrFixed(clb, 1,1); WrStr("m/s ");
    WrInt(ORD(rxbuf[23]), 1); WrStr("sat");

    IF verb2 THEN
      WrStr(" c1="); WrHex(ORD(rxbuf[4]),2);
      WrStr(" a1="); WrHex(ORD(rxbuf[24]),2); WrHex(ORD(rxbuf[25]),2);
      WrStr(" a2="); WrInt(cardmsb(rxbuf, 26, 2),1);
      WrStr(" a3="); WrInt(cardmsb(rxbuf, 28, 2),1);
      WrStr(" c2="); WrHex(ORD(rxbuf[30]),2); WrHex(ORD(rxbuf[31]),2);
      WrStr(" a4="); WrHex(ORD(rxbuf[32]),2); WrHex(ORD(rxbuf[33]),2);
      WrStr(" a5="); WrHex(ORD(rxbuf[34]),2); WrHex(ORD(rxbuf[35]),2);
      WrStr(" a6="); WrInt(cardmsb(rxbuf, 36, 2),1);
      WrStr(" c3="); WrHex(ORD(rxbuf[38]),2); WrHex(ORD(rxbuf[39]),2);
      WrStr(" n="); WrInt(ORD(rxbuf[40]),1);
    END;

    cfg:=cardmsb(rxbuf, 41, 4);
    IF cnt=15 THEN
      WrStr(" date="); WrInt(2000+cfg MOD 100,1);
      WrStr("-");WrInt(cfg DIV 100 MOD 100,1);
      WrStr("-");WrInt(cfg DIV 10000 MOD 100,1);
    ELSIF verb2 THEN WrStr(" cfg="); Whex(cfg DIV 10000H); Whex(cfg) END;

    IF repaired>0 THEN WrStr(" rep="); WrInt(repaired,1) END;

    IF verb2 THEN
      FOR i:=0 TO FLENMP3-1 DO
        IF i MOD 25=0 THEN WrStrLn("") END;
        WrHex(ORD(rxbuf[i]),3);
      END;
    END;  
    done:=TRUE;

  ELSIF (repaired>2) OR verb2 THEN         (* do not show single noise frames as fills screen *)
    WrChan(m);
    WrStr("MRZ ");
    WrInt(cnt, 2);
    IF state=0 THEN WrStr(" crc error copies="); WrInt(repaired, 1);
    ELSE WrStr(" dupe") END;
    done:=TRUE;
  END;
  IF done THEN
    WrdB(chan[m].admax-chan[m].admin);
    WrQuali(noiselevel(chan[m].mp3h.bitlev, chan[m].mp3h.noise));
    WrStrLn("");
  END;
END showmp3;


PROCEDURE decodeframemp3(m:CARDINAL; buf-:ARRAY OF CHAR);
VAR i, flen, cfg, cnt:CARDINAL;
    name:ARRAY[0..20] OF CHAR;
    s:ARRAY[0..200] OF CHAR;
BEGIN
  WITH chan[m].mp3h DO
    cnt:=cardmsb(buf, 0, 1) MOD 16;
    cfg:=cardmsb(buf, 41, 4);
    IF cnt=15 THEN
      dateok:=TRUE;
      gpsdate:=cfg;
      timeatdate:=mp3time(buf);          (* to check day wrap *)
    ELSIF cnt=13 THEN
      id2:=cfg;
      id2ok:=TRUE;
    ELSIF cnt=12 THEN
      id1:=cfg;
      id1ok:=TRUE;
    END;
    IF dateok THEN gpstime:=mp3date(gpsdate, timeatdate, mp3time(buf)) END;
    setactiv(savecnt, 30);

    mp3id(m, FALSE, name);
    IF (gpstime>0) & (name[0]<>0C) THEN
      FILL(ADR(s), 0C, SIZE(s));                                    (* end of block is 0 *)
      FOR i:=0 TO 8 DO s[i+7]:=name[i] END;
      WITH chan[m] DO                                               (* call if set *)
        s[0]:=CHR(mycallc DIV (256*256*256));
        s[1]:=CHR(mycallc DIV (256*256) MOD 256);
        s[2]:=CHR(mycallc DIV (256) MOD 256);
        s[3]:=CHR(mycallc MOD 256);
        IF mycallc>0 THEN s[4]:=myssid ELSE s[4]:=CHR(16) END;
        s[5]:=0C;
        s[6]:=0C;
      END;
      s[16]:=CHR(gpstime DIV (256*256*256));
      s[17]:=CHR(gpstime DIV (256*256) MOD 256);
      s[18]:=CHR(gpstime DIV (256) MOD 256);
      s[19]:=CHR(gpstime MOD 256);

      FOR i:=0 TO FLENMP3-1 DO s[i+20]:=buf[i] END;              (* payload *)

      flen:=20+FLENMP3;
      sdrparm(s, flen, m);
      alludp(chan[m].udptx, flen, s);
    END;
    monitor(m, "MRZ", name);

  END;
END decodeframemp3;

PROCEDURE repairmp3(m:CARDINAL);
VAR i,j,k,max, cnt, done, rprcnt:CARDINAL;
    t, tlast:TIME;
    ch:CHAR;
    rxbuf:MP3BUF;
BEGIN
  rprcnt:=0;
  t:=time();
  WITH chan[m].mp3h DO
    done:=0;
    rxbuf:=copybuf[copycnt].dat;
    tlast:=copybuf[copycnt].time;
    LOOP
--FOR i:=0 TO FLENMP3-1 DO WrHex(ORD(rxbuf[i]),3); END; WrStrLn("");
      IF crcmp3(rxbuf, 0, 45) THEN INC(done,2) END;   (* frame crc ok *)
      IF done>0 THEN EXIT END;

--- got a crc error frame
      j:=0;
      FOR i:=0 TO copycnt DO
        IF copybuf[i].time+4>=t THEN copybuf[j]:=copybuf[i]; INC(j); END;
      END;
      rprcnt:=j;
      copycnt:=j;
      IF copycnt>=3 THEN                      (* enough noisy frames to find max count same bytes *)
        FOR i:=0 TO 46 DO                     (* find best byte *)
          max:=0;
          FOR j:=0 TO copycnt-2 DO
            cnt:=0;
            ch:=copybuf[j].dat[i]; 
            FOR k:=j+1 TO copycnt-1 DO
              IF ch=copybuf[k].dat[i] THEN INC(cnt) END;
            END;
            IF cnt>=max THEN max:=cnt; rxbuf[i]:=copybuf[j].dat[i] END;
          END;
        END;
        IF copycnt>HIGH(copybuf) THEN
          copycnt:=HIGH(copybuf);
          FOR i:=1 TO HIGH(copybuf) DO copybuf[i-1]:=copybuf[i] END;
        END;
      END;
      done:=1;
    END;
    IF done>=2 THEN                                                    (* good or repaired frame *)
      IF (tlast+4>=t) & ((blocknum<>ORD(rxbuf[0]) MOD 16) OR (blocktime+16<t)) THEN (* new block *)
        blocknum:=ORD(rxbuf[0]) MOD 16;
        blocktime:=t;
        decodeframemp3(m, rxbuf);
        IF verb THEN showmp3(m, 1, rprcnt, rxbuf) END;
      ELSIF verb THEN showmp3(m, 2, rprcnt, rxbuf) END;
      copycnt:=0;
    END;
    IF verb & (done=1) THEN showmp3(m, 0, rprcnt, rxbuf) END;
  END;
END repairmp3;

PROCEDURE demodbytemp3(m:CARDINAL; d:BOOLEAN);
CONST SYNWORD=CAST(SET32,0BF35H);
      SYNWORDREV=SYNWORD/SET32{0..15};
BEGIN
  WITH chan[m].mp3h DO
--  IF savecnt>0 THEN
      synword:=synword*2 + ORD(d);

      IF rxp>=FLENMP3 THEN                                               (* out of frame *)
        IF CAST(SET32, synword)*SET32{0..15}=SYNWORD THEN
          rxp:=0;
          copybuf[copycnt].time:=time();
        ELSIF CAST(SET32, synword)*SET32{0..15}=SYNWORDREV THEN
          polarity:=NOT polarity;
          rxp:=0;
          copybuf[copycnt].time:=time();
        END; 
      ELSE 
        INC(rxb);
        IF rxb>=8 THEN      
          copybuf[copycnt].dat[rxp]:=CHR(synword MOD 100H);
          rxb:=0;
          INC(rxp);
          IF rxp=FLENMP3 THEN repairmp3(m) END;                              (* frame full *)
        END;
      END;
--  END; 
  END;
END demodbytemp3;


PROCEDURE demodbitmp3(m:CARDINAL; u,u0:REAL);
VAR dm:BOOLEAN;
    ua:REAL;
BEGIN
  dm:=u0<0.0;
  WITH chan[m].mp3h DO
    IF lastmanch=(u0<0.0) THEN INC(manchestd, (32767-manchestd) DIV 16) END;
    lastmanch:=u0<0.0;
    manchestd:=-manchestd;
    IF (manchestd<0) THEN
      demodbytemp3(m, (u>=u0)=polarity);
      demodbytemeisei(m, dm=dmeis);
(*quality*)
      ua:=ABS(u-u0)-bitlev;
      bitlev:=bitlev + ua*0.005;
      noise:=noise + (ABS(ua)-noise)*0.02;
(*quality*)

    END;
    dmeis:=dm;
  END;
END demodbitmp3;

PROCEDURE demodmp3(u:REAL; m:CARDINAL);
VAR d:BOOLEAN;
BEGIN
  WITH chan[m].mp3h DO
    d:=u>=0.0;
    IF cbit THEN
      demodbitmp3(m, u, lastu);
      IF d<>oldd THEN

        IF d=plld THEN INC(baudfine, pllshift) ELSE DEC(baudfine, pllshift) END;
        oldd:=d;
      END;
      lastu:=u;
    ELSE plld:=d END;
    cbit:=NOT cbit;
  END;

END demodmp3;

PROCEDURE Fskmp3(m:CARDINAL);
VAR ff:REAL;
    lim:INTEGER;
BEGIN
  WITH chan[m].mp3h DO
    lim:=demodbaud;
    LOOP
      IF baudfine>=BAUDSAMP THEN
        DEC(baudfine, BAUDSAMP);
        ff:=Fir(afin, baudfine MOD BAUDSAMP DIV (BAUDSAMP DIV AOVERSAMP),
        AOVERSAMP, chan[m].afir, afirtab);
        demodmp3(ff, m);
      END;
      INC(baudfine, lim);
      lim:=0;
      IF baudfine<BAUDSAMP*2 THEN EXIT END;

    END;
  END;
END Fskmp3;


------------------------

PROCEDURE DecWater(c:CARDINAL; bit:BOOLEAN);
CONST CRCINIT=0FFFFFFFFH;
      WBSTART=0A5H;
      WWSTART=0CA55F047H;
      WBCRC  =07FH; 
VAR i, ww, crc:CARDINAL;
BEGIN
--WrStr("(");WrInt(ORD(bit), 1);WrStr(")");
  WITH chan[c] DO
    waterbyte:=waterbyte DIV 2;                                      (* shift in 40 bits *)
    IF ODD(waterword) THEN INC(waterbyte, 128) END;
    waterword:=waterword DIV 2;
    IF bit THEN INC(waterword, 80000000H) END;
    IF (waterbyte=WBSTART) & (waterword=WWSTART) THEN waterbits:=41; (* frame start found *)
    ELSIF waterbits>40 THEN                                          (* in frame *)
      IF waterbits MOD 40=0 THEN                                     (* byte + word ready *)  
        ww:=waterbits DIV 40-2;
        IF waterbyte=WBCRC THEN                                      (* crc is end of frame *)
          crc:=CRCINIT;
          i:=0; 
          WHILE i<ww DO
            crc32(crc, ORD(watertemp[i].cmd));
            crc32(crc, watertemp[i].dat);
            crc32(crc, watertemp[i].dat DIV 100H);
            crc32(crc, watertemp[i].dat DIV 10000H);
            crc32(crc, watertemp[i].dat DIV 1000000H);
            INC(i);
          END;
          IF ww<=HIGH(watertemp) THEN watertemp[ww].cmd:=0C END;     (* end of data block *)
          waterbits:=0;
          IF crc=waterword THEN
            waterdata:=watertemp;
            waterok:=TRUE;
            watersend:=time();
            i:=0;
            LOOP
              IF (i>HIGH(waterdata)) OR (waterdata[i].cmd=0C) THEN EXIT END;
  
              IF waterdata[i].cmd=cFREQ THEN chlabel:=waterdata[i].dat; EXIT END; (* use freq as channel name *)

              INC(i);
            END;              
          END;
        ELSIF ww<=HIGH(watertemp) THEN                               (* store byte + word *)
          watertemp[ww].cmd:=CHR(waterbyte); 
          watertemp[ww].dat:=waterword;
        END;
      END;
      INC(waterbits);
    END;
  END;
END DecWater;


PROCEDURE findcontext(label:CARDINAL):pNONAMES;
VAR i:CARDINAL;
    pl, po, pn:pNONAMES;
    t:TIME;
    old:BOOLEAN;
BEGIN
  t:=time();
  i:=0;
  pl:=NIL;
  LOOP                                                  (* look at all channels *)
    pl:=chan[i].nonames;
    IF (pl<>NIL) & (pl^.chname=label) THEN              (* label is on another channel *)
      chan[i].nonames:=NIL;                             (* remove it *)
--IF verb THEN WrStr("found context "); WrChName(label); WrStr(" on channel "); WrInt(i+1,1); WrStrLn("") END;
      EXIT

    END;
    INC(i);
    IF i>HIGH(chan) THEN EXIT END;

  END;

  IF pl=NIL THEN                                        (* not found on channels *)
    pl:=oldnonames;                                     (* history of contexts *)
    po:=NIL;
    LOOP                                                (* look in history and purge *)
      IF pl=NIL THEN EXIT END;

      pn:=pl^.next;
      old:=(pl^.lastvalid<>0) & (pl^.lastvalid+CONTEXTLIFE<t);
      IF old OR (pl^.chname=label) THEN                                (* remove from chain *)
        IF po=NIL THEN oldnonames:=pn ELSE po^.next:=pn END;           (* unchain pl *)
        IF old THEN DEALLOCATE(pl, SIZE(pl^)); pl:=NIL
        ELSE
--IF verb THEN WrStr("found context "); WrChName(label); WrStrLn(" on history") END;
        EXIT END;

      ELSE po:=pl END;
      pl:=pn;
    END;
  END;


  IF (pl<>NIL) & (pl^.lastvalid<>0) & (pl^.lastvalid+CONTEXTLIFE<t) THEN
    DEALLOCATE(pl, SIZE(pl^));
    pl:=NIL;
IF verb THEN WrStr("free timed out context "); WrChName(label); WrStrLn(""); END;
  END;
  RETURN pl
END findcontext;

PROCEDURE cpusave(savelev:INTEGER; chans:CARDINAL);

  PROCEDURE sdec(en:ENABLE; VAR cnt:INTEGER; dur:INTEGER); (* set on/off intervall of inactiv demod *)
  BEGIN
    IF en<>OFF THEN
      IF en=SLEEP THEN DEC(cnt) END;
      IF cnt<=-savelev THEN cnt:=dur END;
--WrInt(cnt, 6); WrStrLn(" sc");
    END;
  END sdec;

VAR c:CARDINAL;
BEGIN
  FOR c:=0 TO chans DO
    WITH chan[c] DO
      sdec(r92.enabled, r92.savecnt, 2);
      sdec(r41.enabled, r41.savecnt, 2);
      sdec(c34a.enabled, c34a.savecnt, 1);
      sdec(dfm6a.enabled, dfm6a.savecnt, 1);
      sdec(imeta.enabled, imeta.savecnt, 2);
      sdec(m10.enabled, m10.savecnt, 1);
      sdec(mp3h.enabled, mp3h.savecnt, 1);
    END;
  END;
END cpusave;


PROCEDURE getadc;
VAR
    l, i, m, sl, pp:INTEGER;
    c, ch: CARDINAL;
BEGIN
  c:=0;
  REPEAT

    IF adcbufrd>=adcbufsamps THEN
      adcbufrd:=0;
      l:=RdBin(soundfd, adcbuf, adcbuflen*ADCBYTES);

      adcbufsamps:=0;
      IF l<0 THEN
        IF abortonsounderr THEN Error("Sounddevice Failure");
        ELSE
          Close(soundfd);
          usleep(100000);
          OpenSound;
          RETURN

        END;
      ELSIF l<ADCBYTES THEN RETURN END;

      adcbufsamps:=l DIV ADCBYTES;
      IF debfd>=0 THEN WrBin(debfd, adcbuf, adcbufsamps*ADCBYTES) END;
      adcbufsampx:=MAX(CARDINAL);
    END;

    sl:=adcbuf[adcbufrd];
    IF (cfgchannels=0) & ODD(sl) THEN               (* auto channels channel 0 *)
--WrInt(lastc, 1); WrStrLn(" ch1");

      IF adcbufsampx<>MAX(CARDINAL) THEN
        ch:=adcbufrd-adcbufsampx-1;
--WrInt(ch, 1); WrStrLn(" ch");
        IF ch<HIGH(chan) THEN
          IF verb & (maxchannels<>ch) THEN
            WrStr("channels changed from ");
            WrInt(maxchannels+1, 0);
            WrStr(" to ");
            WrInt(ch+1, 0);
            WrStrLn("");
          END;
          maxchannels:=ch;
        END;
      END;
      adcbufsampx:=adcbufrd;
      c:=0;
    END;

    sl:=CAST(INTEGER, CAST(SET32, sl)*SET32{1..31});
    IF sl=0 THEN INC(chan[c].squelch) ELSE chan[c].squelch:=0 END; 
    INC(adcbufrd);
    chan[c].afir[afin]:=VAL(REAL, sl-(chan[c].admax+chan[c].admin) DIV 2);

    IF waterenabled THEN DecWater(c, 1 IN CAST(SET32, sl)) END;  (* watermark bit *)

    IF sl>chan[c].admax THEN chan[c].admax:=sl END;
    IF sl<chan[c].admin THEN chan[c].admin:=sl END;
    pp:=(chan[c].admax-chan[c].admin) DIV 256;
    chan[c].admax:=chan[c].admax-pp;
    chan[c].admin:=chan[c].admin+pp;

    INC(c);
  UNTIL c>maxchannels;

  afin:=(afin+1) MOD AFIRLEN;

  INC(sampcount);
  IF (sampcount>adcrate) & (savelevel>0) THEN                    (* every 1 second *)
    sampcount:=0;
    cpusave(savelevel, maxchannels);                             (* lull inactive modems to sleep *)
  END;

  FOR c:=0 TO maxchannels DO
    WITH chan[c] DO
      IF squelch<64 THEN                                         (* squelch open *)

        IF (r92.savecnt>0) OR (r41.savecnt>0) THEN Fsk(c) END;

        IF (c34a.savecnt>0) OR (dfm6a.savecnt>0) OR (imeta.savecnt>0) THEN   (* variable contexts *)

          IF chlabel<>0 THEN                                     (* got label from sdr *)  
            IF (nonames<>NIL) & (chlabel<>nonames^.chname) THEN  (* channel has a different label *)
              IF nonames^.chname<>0 THEN                         (* channel has a label *)
IF verb THEN WrStr("save context "); WrChName(nonames^.chname); WrStr(" from channel "); WrInt(c+1,1); WrStrLn("") END;
                nonames^.next:=oldnonames;                       (* move context to storage *)
                oldnonames:=nonames;
                nonames:=NIL;
              ELSE DEALLOCATE(nonames, SIZE(nonames^)); nonames:=NIL; END;
            END;

            IF nonames=NIL THEN nonames:=findcontext(chlabel) END;    (* fitting context or nil *)
          END; 
          IF nonames=NIL THEN
            ALLOCATE(nonames, SIZE(nonames^));
            IF nonames<>NIL THEN FILL(nonames, 0C, SIZE(nonames^)) END;
          END;
          IF nonames<>NIL THEN                                   (* not out of memory *)
            IF chlabel<>0 THEN nonames^.chname:=chlabel; chlabel:=0 END;  (* give context a label *)
            IF c34a.savecnt>0 THEN Afsk(c) END;
            IF dfm6a.savecnt>0 THEN Fsk6(c) END;
            IF imeta.savecnt>0 THEN Afsk202(c) END;
          END;
        END; 

        IF m10.savecnt>0 THEN Fsk10(c) END;

        IF mp3h.savecnt>0 THEN Fskmp3(c) END;
      END;
    END;
  END;
END getadc;

PROCEDURE Gencrctab;
CONST POLY=SET16{12,5,0};
VAR i, j:CARD16;
    crc:SET16;
BEGIN
  FOR i:=0 TO 255 DO
    crc:=CAST(SET16, i*256);
    FOR j:=0 TO 7 DO
      IF 15 IN crc THEN crc:=SHIFT(crc,1)/POLY ELSE crc:=SHIFT(crc,1) END;
    END;
    CRCTAB[i]:=SHIFT(crc, -8)+SHIFT(crc, 8);
  END;
END Gencrctab;


BEGIN
  Gencrctab;
  GenCRC32tab;
  monitorudp:=NIL;
  FILL(ADR(chan), 0C, SIZE(chan));
  Parms;
  initrsc;

  getst:=0;
  afin:=0;
  soundbufs:=0;
--  IF verb THEN WrStrLn("Frame ID       level-L qual level-R qual") END;

  adcbufrd:=0;
  adcbufsamps:=0;
  adcbufsampx:=MAX(CARDINAL);
  oldnonames:=NIL;
  cpusave(0, HIGH(chan));
  LOOP
    getadc;
  END;
END sondeudp.