<*+M2EXTENSIONS *>
<*-CHECKDIV *>
<*-CHECKRANGE *>
<*-GENFRAME*>
<*-COVERFLOW *>
<*-IOVERFLOW*>
<*-NOPTRALIAS*>
<*-DOREORDER*>
<*-PROCINLINE*>
<*-GENPTRINIT*>
<*+STORAGE *>
<* IF __GEN_C__ THEN *>
  <*GENWIDTH="120"*>
  <*+STORAGE *>
  <*-GENCTYPES*>
  <*+COMMENT*>
  <*-GENHISTORY*>
  <*-GENDEBUG*>
  <*-GENDATE*>
  <*-LINENO*>
  <*-CHECKINDEX*>
  <*-CHECKDINDEX*>
  <*+GENCDIV*>
  <*-GENKRC*>
  <*+NOOPTIMIZE*>
  <*-GENSIZE*>
  <*-ASSERT*>
  <*-CHECKNIL*>
  <*-COVERFLOW*>
  <*-IOVERFLOW*>
  <*-CHECKRANGE*>
  <*-CHECKSET*>
  <*-CHECKDIV*>
  <*-GENCONSTENUM*>
  <*-ASSERT*>
<* ELSE *>
  <*HEAPLIMIT="100000000"*>
  <*+GENHISTORY*>
  <*+GENDEBUG*>
  <*-GENDATE*>
  <*+LINENO*>
  <*+CHECKINDEX*>
  <*+CHECKDNDEX*>
  <*+NOOPTIMIZE*>
  <*-GENSIZE*>
  <*-ASSERT*>
  <*+CHECKNIL*>
  <*-COVERFLOW*>
  <*-IOVERFLOW*>
  <*-CHECKRANGE*>
  <*-CHECKSET*>
  <*-CHECKDIV*>
  <*-GENCONSTENUM*>
<* END *>
<*NEW WITHAPRS*>
<*+WITHAPRS*>
(*
gcc  -o tetradec Lib.o aprspos.o aprsstr.o filesize.o flush.o osi.o ptty.o symlink.o tcp.o tetradec.o timec.o udp.o viterbi_cch.o  /usr/local/xds/lib/x86/libts.a /usr/local/xds/lib/x86/libxds.a  -lm -lrt conv.o tetra/cdec_tet.o tetra/fbas_tet.o tetra/fmat_tet.o tetra/sdec_tet.o tetra/sub_dsp.o tetra/tetra_op.o tetra/csdecoder.o tetra/fexp_tet.o tetra/sdecode.o tetra/sub_cd.o tetra/sub_sc_d.o
*)


MODULE tetrarx; (* iq synchronous dqpsk and tetra decoder *)

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

FROM osi IMPORT Werr, WrStr, WrStrLn, WrInt, File, OpenRead, Close,
     WrFixed, ALLOCATE, NextArg, RdBin, time, IsFifo, WerrLn, Flush,
     OpenWrite, Seekend, WrBin, OpenNONBLOCK, OpenAppend, WrCard, realcard, udpsend, openudp;
FROM math IMPORT sin, cos, log, sqrt, atan, pow;
FROM viterbi_cch IMPORT conv_cch_decode; 
IMPORT csdecoder;

FROM aprsstr IMPORT StrToCard, StrToInt, StrToFix, Append, CardToStr, TimeToStr, FixToStr,
                    DateToStr, Length, Assign, IntToStr;
FROM signal IMPORT signal, SIGPIPE;

CONST
      PI=3.1415926535;
      PI2=PI*2.0;
      LF=12C;
      MAXINBUF=4096;
      LOGNFSK=2;
      NFSK=1<<LOGNFSK;
      OVERSAMP=16;
      BAUD=100.0;
      MAXDEMODS=256;
      MAXSUBBANDS=256;
      DDSLEN=16384; 
      CHECKSNR=8.0;                             (* send new payload id only over this snr *)
      MODD="d";
      PLLGAIN=3200;                             (* 3200  d4psk psk pll loop gain *)
TYPE
     Complex=RECORD Re, Im:REAL END;
     SET8= SET OF [0..7];
     SET16=SET OF [0..15];
     SET32=SET OF [0..31];
     IPNUM=CARDINAL;
     UDPPORT=CARDINAL;
     LPCONTEXT24=RECORD
       uc1, uc2, il, LPR, OLPR, LPL:REAL;
     END;
     FRAME=ARRAY[0..100] OF CHAR;
     DEMOD=RECORD
       lastn,
       symclk,
       framewp,
       synword     :CARDINAL;  
       ppm         :INTEGER;
       frame       :FRAME;
       afc,
       levm,
       noism       :REAL;
     END;
    
     pDQPSKMODEM=POINTER TO DQPSKMODEM;
     DQPSKMODEM=RECORD
       next        :pDQPSKMODEM;
       iflpi,
       iflpq       :LPCONTEXT24;
       iffreq,
       iffreqc,
       iffreqafc,
       ifosc       :CARD16;
       lastd       :CARD8;
       modemnum,
       vcnt,
       state,
       baud,
       ifsamp,
       ifsamprate,
       pllosc,
       ifstep      :CARDINAL;
       maxcroase,
       croase,
       dir         :INTEGER;
       fm,
       fmo,
       ddsbase, 
       ifwidth,
       rflevel,
       lastlev,
       noise,
       qual,
       lev1,
       lev2,
       lowlev,
       olev,
       pllf,
       plllag,
       level       :REAL;
       synwh,
       synw        :SET32;
       ftyp,
       fend,
       fifop       :CARDINAL;
       fifo        :ARRAY[0..509] OF INT8;
     END;

VAR
    dqpskmodems :pDQPSKMODEM;
    iqfn        :ARRAY[0..1023] OF CHAR;    
    ccfilename,
    bfofreq,
    scanoffs,
    jfd,
    iqfd        :INTEGER;
    jipnum,
    jipport,
    owrxverb,
    owrxlastvoice,
    voicenow,
    insamprate,
    isize       :CARDINAL;
    owrxhasvoice,
    u8signed,
    ccdone,
    verb,
    verb2       :BOOLEAN;
    udpsock     :INTEGER;
    iqbuf:ARRAY[0..MAXINBUF*2-1] OF INT16;
    DDS :ARRAY[0..DDSLEN-1] OF INT16;
    checktable  :ARRAY[0..10] OF RECORD payload, time:CARDINAL END;
    decodingtable:ARRAY[0..2047] OF CARDINAL;
    jline:ARRAY[0..2047] OF CHAR;

CONST
      RAD=PI/180;

      D4BITS=2;                            (* bits per symbol *)
      SBBLK1BITS=60*D4BITS;
      SBBLK2BITS=108*D4BITS;
      SBBBKBITS=30;
      NDBBBK1BITS=7*D4BITS;
      NDBBBK1OFFSET=(5+1+1+108)*D4BITS;
      NDBBBK2OFFSET=(5+1+1+108+7+11)*D4BITS;
      NDBBBK2BITS=8*D4BITS;
      NDBBLKBITS=108*D4BITS;
      NDBBLK1OFFSET=(5+1+1)*D4BITS;
      NDBBLK2OFFSET=(5+1+1+108+7+11+8)*D4BITS;
      UNDBBLK1OFFSET=(14)*D4BITS;
      UNDBBLK2OFFSET=(14+108+11)*D4BITS;


TYPE
     CONTEXT=RECORD
       xor         :SET32;
       mn,tn,fn, mccmnc, bcc, la, lac, ccc:CARDINAL;
       offset      :INTEGER;
       dmhz, db    :REAL;
       istrafic    :BOOLEAN;
     END;

    pMCC=POINTER TO MCC;
    MCC=RECORD
      next:pMCC;
      mccmnc:CARDINAL;
      text:ARRAY[0..40] OF CHAR;
    END;


CONST SCRAMBINIT=SET32{0,1};
      INB=16384;
      CHANS=4;
      DLEN=432;
      ALEN=480;
      MINFOUND=1;
      RXDEL=10;
      RXDELLONG=100;
      SCANTOL=10000;
VAR 
    scanonce,
    scanfound,
    isuplink,
    rxany       :BOOLEAN;
    soundfd     :INTEGER;
    chanfds     :ARRAY[0..CHANS-1] OF INTEGER;
    scanstate,
    rxdelay,
    scansteps, 
    nosoundcnt,
    channels    : CARDINAL;
    RMTAB:ARRAY[0..16383] OF SET32;
    audiobufs:ARRAY[0..CHANS-1] OF RECORD
                af:ARRAY[0..ALEN-1] OF INT16;
                alc:REAL;
                filled:BOOLEAN;
              END;
    cachpm,
    mcc         :pMCC;
    cachmn      :CARDINAL;
    mccfilename :ARRAY[0..1000] OF CHAR;
    context     :CONTEXT;

PROCEDURE Error(text-:ARRAY OF CHAR);
BEGIN
  Werr("tetrarx:"); Werr(text); Werr(" error abort"+LF);
  HALT
END Error;

PROCEDURE verbo(eol:BOOLEAN):BOOLEAN;    (* reduce verbosity on no voice for owrx *)
BEGIN
  IF NOT verb THEN RETURN FALSE END;
  IF owrxverb=0 THEN RETURN TRUE END;

  IF owrxlastvoice=owrxverb THEN 
     IF owrxhasvoice THEN WrStrLn("No voice now") ELSE WrStrLn("No or Encrypted Voice Service") END;
     INC(owrxlastvoice); 
   END;
  IF owrxlastvoice>owrxverb THEN RETURN FALSE;
  ELSIF eol THEN INC(owrxlastvoice) END;  
  RETURN TRUE
END verbo;

PROCEDURE Appjs(s-:ARRAY OF CHAR);
BEGIN Append(jline, '"'); Append(jline,s); Append(jline, '"') END Appjs;

PROCEDURE Appj(s-:ARRAY OF CHAR);
BEGIN
  IF jline[0]<>0C THEN Append(jline, ",") END;
  Appjs(s); Append(jline,":"); 
END Appj;

PROCEDURE Appjc(n:CARDINAL);
VAR h:ARRAY[0..30] OF CHAR;
BEGIN
  CardToStr(n,1,h); Append(jline,h);
END Appjc;

PROCEDURE Appji(n:INTEGER);
VAR h:ARRAY[0..30] OF CHAR;
BEGIN
  IntToStr(n,1,h); Append(jline,h);
END Appji;

PROCEDURE Appjf(r:REAL; f:CARDINAL);
VAR h:ARRAY[0..30] OF CHAR;
BEGIN
  FixToStr(r,f,h); Append(jline,h);
END Appjf;


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

PROCEDURE HexStr(x, digits, len:CARDINAL; cap:BOOLEAN; VAR s:ARRAY OF CHAR);
VAR i:CARDINAL;
BEGIN
  IF digits>HIGH(s) THEN digits:=HIGH(s) END;
  i:=digits;
  WHILE (i<len) & (i<HIGH(s)) DO
    s[i]:=" ";
    INC(i);
  END;
  s[i]:=0C;
  WHILE digits>0 DO
    DEC(digits);
    s[digits]:=hex(x, cap);
    x:=x DIV 16;
  END;
END HexStr;

PROCEDURE WrHex(x, digits, len:CARDINAL);
VAR s:ARRAY[0..255] OF CHAR;
BEGIN
  HexStr(x, digits, len, FALSE, s);
  WrStr(s);
END WrHex;

PROCEDURE WrHexCap(x, digits, len:CARDINAL);
VAR s:ARRAY[0..255] OF CHAR;
BEGIN
  HexStr(x, digits, len, TRUE, s);
  WrStr(s);
END WrHexCap;


PROCEDURE ChHex(c:CHAR; VAR s:ARRAY OF CHAR);
BEGIN
  IF (c>=177C) OR (c<" ") THEN
    s[0]:="[";
    s[1]:=hex(ORD(c) DIV 16, FALSE);
    s[2]:=hex(ORD(c), FALSE);
    s[3]:="]";
    s[4]:=0C;
  ELSE s[0]:=c; s[1]:=0C; END;
END ChHex;

PROCEDURE WrChHex(c:CHAR);
VAR s:ARRAY[0..10] OF CHAR;
BEGIN
  ChHex(c, s);
  WrStr(s);
END WrChHex;


PROCEDURE sqr(x:REAL):REAL;
BEGIN RETURN x*x END sqr;

PROCEDURE atan2(u-:Complex):REAL;
VAR w:REAL;
    abs:Complex;
BEGIN
  abs.Re:=ABS(u.Re);
  abs.Im:=ABS(u.Im);
  IF abs.Im>abs.Re THEN
    IF abs.Im>0.0 THEN w:=abs.Re/abs.Im ELSE w:=0.0 END;
    w:=PI/2.0 - (w*1.055 - w*w*0.267);                    (* arctan *)
  ELSE
    IF abs.Re>0.0 THEN w:=abs.Im/abs.Re ELSE w:=0.0 END;
    w:=w*1.055 - w*w*0.267;
  END;
  IF u.Re<0.0 THEN w:=PI-w END;
  IF u.Im<0.0 THEN w:=-w END;
  RETURN w
END atan2;

PROCEDURE dB(u:REAL):REAL;
BEGIN
  IF u>0.0001 THEN RETURN log(u)*8.68588963 END;
  RETURN 0.0
END dB;

PROCEDURE fmhighpass(w:REAL; VAR w1:REAL):REAL;
VAR af:REAL;
BEGIN
(* phase highpass make FM out of phase *)
  af:=w-w1;
  w1:=w;
  IF af> PI THEN af:=af - PI*2.0 END;
  IF af<-PI THEN af:=af + PI*2.0 END;
  RETURN af
END fmhighpass;

---------- write wav header
PROCEDURE wwav(fd:INTEGER; hz, chan:CARDINAL);
CONST bytes=2;
VAR b:ARRAY[0..43] OF CHAR;
BEGIN
  b:="RIFF    WAVEfmt ";
  b[4]:=377C;                                     (* len *)
  b[5]:=377C;
  b[6]:=377C;
  b[7]:=377C;

  b[16]:=20C;
  b[17]:=0C;
  b[18]:=0C;
  b[19]:=0C;

  b[20]:=1C;                                      (* PCM/ALAW *)
  b[21]:=0C;

  b[22]:=CHR(chan);                               (* channels *)
  b[23]:=0C;

  b[24]:=CHR(hz MOD 100H);                        (* samp *)
  b[25]:=CHR(hz DIV 100H MOD 100H);
  b[26]:=CHR(hz DIV 10000H MOD 100H);
  b[27]:=CHR(hz DIV 1000000H);

  b[28]:=CHR(hz*bytes MOD 256);                   (* byte/s *)
  b[29]:=CHR(hz*bytes DIV 256 MOD 256);
  b[30]:=CHR(hz*bytes DIV 65536);
  b[31]:=0C;

  b[32]:=CHR(bytes);                              (* block byte *)
  b[33]:=0C;
  b[34]:=20C;                                     (* bit/samp *)
  b[35]:=0C;

  b[36]:="d";
  b[37]:="a";
  b[38]:="t";
  b[39]:="a";

  b[40]:=377C;       (* len *)
  b[41]:=377C;
  b[42]:=377C;
  b[43]:=377C;

  IF fd>=0 THEN WrBin(fd, b, 44) END;
END wwav;


PROCEDURE MakeDDS(VAR dds:ARRAY OF REAL);
VAR i:CARDINAL;
    r:REAL; 
BEGIN
  r:=PI*2.0/FLOAT(HIGH(dds)+1);
  FOR i:=0 TO HIGH(dds) DO dds[i]:=sin(FLOAT(i)*r) END;
END MakeDDS;

PROCEDURE MakeDDSi(VAR dds:ARRAY OF INT16);
VAR i:CARDINAL;
    r:REAL; 
BEGIN
  r:=PI*2.0/FLOAT(HIGH(dds)+1);
  FOR i:=0 TO HIGH(dds) DO dds[i]:=VAL(INT16, 16383.9*sin(FLOAT(i)*r)) END;
END MakeDDSi;


PROCEDURE makelp24(fg, samp:REAL; VAR c:LPCONTEXT24);
BEGIN
  WITH c DO
    LPR:=fg/samp*2.33363;
    LPL:=LPR*LPR*2.888*(1.0-5.0*pow(fg/samp,2.0));
    OLPR:=1.0-LPR;
  END;
END makelp24;

PROCEDURE createnonblockfile(fn:ARRAY OF CHAR):INTEGER;
VAR fd:INTEGER;
BEGIN
  fd:=OpenNONBLOCK(fn);
  IF (fd<0) OR NOT IsFifo(fd) THEN   (* no pipe *)
    IF fd>=0 THEN Close(fd) END;
    fd:=OpenWrite(fn)
  END;
  RETURN fd
END createnonblockfile;


PROCEDURE Parms;
VAR err,
    ok        :BOOLEAN;
    stored,
    ifwid,
    afclim,
    n,
    fskbaud,
    fixedlen,
    i              :CARDINAL; 
    h              :ARRAY[0..1023] OF CHAR;
    bfof,
    tune           :INTEGER;
    baseband,
    baud           :REAL;
    mod,
    ademod         :CHAR;
    pq             :pDQPSKMODEM;
    syncpattern,
    syncmask       :SET32;
    lasth            : CHAR;
    mnc,mcc,bcc,
    ch,
    val              : CARDINAL;

  PROCEDURE newmodem;
  VAR i:CARDINAL;
  BEGIN
    IF VAL(CARDINAL, ABS(tune))*2>insamprate THEN Error("tuned outside bandwidth (-t)") END;

    IF mod=MODD THEN  
      ALLOCATE(pq, SIZE(pq^));
      IF pq=NIL THEN Error("out of memory") END;

      FILL(pq, 0C, SIZE(pq^));
      pq^.baud:=fskbaud;
      pq^.ifsamprate:=fskbaud*4;
      pq^.ifwidth:=FLOAT(ifwid);
      IF fskbaud*2>pq^.ifsamprate THEN pq^.ifsamprate:=fskbaud*2 END;

      pq^.ifstep:=TRUNC(FLOAT(pq^.ifsamprate)/FLOAT(insamprate)*FLOAT(MAX(CARDINAL)));
      makelp24(pq^.ifwidth*0.5, FLOAT(insamprate), pq^.iflpi);
      makelp24(pq^.ifwidth*0.5, FLOAT(insamprate), pq^.iflpq);
      pq^.ddsbase:=FLOAT(DDSLEN)/FLOAT(insamprate);
      pq^.iffreq:=VAL(INTEGER, pq^.ddsbase*FLOAT(tune));
      pq^.maxcroase:=VAL(INTEGER, pq^.ddsbase*FLOAT(afclim));
      pq^.modemnum:=stored;
      pq^.next:=dqpskmodems;
      dqpskmodems:=pq;
      IF verb THEN
        WrStrLn("");
        WrStr("offset:"); WrInt(tune, 1); WrStrLn("Hz");
        IF afclim>0 THEN WrStr("max.afc:+-"); WrInt(afclim, 1); WrStrLn("Hz") END;
        WrStr("if-bandwidth:"); WrInt(VAL(INTEGER, pq^.ifwidth),1);  WrStrLn("Hz");
        WrStr("if-samplerate:"); WrCard(pq^.ifsamprate, 1); WrStrLn("Hz");
        WrStr("baud:"); WrCard(fskbaud, 1);
        WrStrLn("");
      END;

    END;
  END newmodem;

  PROCEDURE num(VAR v:CARDINAL; h-:ARRAY OF CHAR; VAR i:CARDINAL);
  VAR n:CARDINAL;
      sg:BOOLEAN; 
  BEGIN
    IF h[i]<>"," THEN
      sg:=FALSE;
      n:=0;
      IF h[i]="+" THEN INC(i) ELSIF h[i]="-" THEN sg:=TRUE; INC(i) END;
      WHILE (i<HIGH(h)) & (h[i]<>",") & (h[i]>="0") & (h[i]<="9") DO
        n:=n*10 + ORD(h[i])-ORD("0");
        INC(i);
      END;
      IF sg THEN n:=-VAL(INTEGER,n) END;
      v:=n;
    END;
  END num;

  PROCEDURE numm(h-:ARRAY OF CHAR; VAR i:CARDINAL):INTEGER;
  VAR n:CARDINAL;
      sg:BOOLEAN;
  BEGIN
    IF h[i]<>"," THEN
      sg:=FALSE;
      n:=0;
      IF h[i]="+" THEN INC(i) ELSIF h[i]="-" THEN sg:=TRUE; INC(i) END;
      WHILE (i<HIGH(h)) & (h[i]<>",") & (h[i]>="0") & (h[i]<="9") DO
        n:=n*10 + ORD(h[i])-ORD("0");
        INC(i);
      END;
      IF sg THEN RETURN -VAL(INTEGER,n) END;
      RETURN n
    END;
    RETURN 0
  END numm;

PROCEDURE getscramb(mcc, mnc, colour:CARDINAL):SET32;   (*p.723*)
BEGIN
  RETURN SCRAMBINIT + SHIFT(
         CAST(SET32,colour)*SET32{0..5}
         + SHIFT(CAST(SET32,mnc)*SET32{0..13},6)
         + SHIFT(CAST(SET32,mcc)*SET32{0..9},20),2)
END getscramb;

PROCEDURE GetIp(h:ARRAY OF CHAR; VAR ip:CARDINAL; VAR port:CARDINAL):INTEGER;

CONST DEFAULTIP=7F000001H;
      PORTSEP=":";

VAR i, n, p:CARDINAL;
    ok:BOOLEAN;
BEGIN
  p:=0;
  h[HIGH(h)]:=0C;
  ip:=0;
  FOR i:=0 TO 4 DO
    IF (i>=3) OR (h[0]<>PORTSEP) THEN
      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;

    END;
    IF i<3 THEN
      IF h[0]<>PORTSEP THEN
        IF (h[p]<>".") OR (n>255) THEN RETURN -1 END;

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

    ELSIF n>65535 THEN RETURN -1 END;

    port:=n;
    INC(p);
  END;
  RETURN 0
END GetIp;


BEGIN
  mod:=MODD;
  ademod:=0C;
  iqfn:="";
  isize:=1;
  verb:=FALSE;
  verb2:=FALSE;
  err:=FALSE;
  insamprate:=0;
  tune:=0;
  fskbaud:=18000;
  baud:=BAUD;
  ifwid:=20000;
  stored:=0;
  afclim:=0;
  u8signed:=FALSE;
  syncpattern:=SET32{};
  syncmask:=SET32{};
  fixedlen:=0;
  err:=FALSE;
  soundfd:=-2;
  channels:=2;
  owrxverb:=0;
  voicenow:=1000;
  owrxlastvoice:=0;
  owrxhasvoice:=TRUE;
  udpsock:=-1;
  jfd:=-1;
  FOR ch:=0 TO HIGH(chanfds) DO chanfds[ch]:=-1 END;
  ch:=0;

  LOOP

    NextArg(h);
    IF h[0]=0C THEN EXIT END;
    IF (h[0]="-") & (h[1]<>0C) & (h[2]=0C) THEN
      IF h[0]="u" THEN
        NextArg(h);
        i:=0;
        mcc:=numm(h, i);
        IF h[i]<>"," THEN Error("-u mcc,mnc,bcc") END;
        INC(i);
        mnc:=numm(h, i);
        IF h[i]<>"," THEN Error("-u mcc,mnc,bcc") END;
        INC(i);
        bcc:=numm(h, i);
        IF h[i]<>0C THEN Error("-u mcc,mnc,bcc") END;
        context.xor:=getscramb(mcc,mnc,bcc);
        isuplink:=TRUE;


      ELSIF h[1]="c" THEN
        NextArg(h);
        IF NOT StrToCard(h, channels) OR (channels<>1) & (channels<>2) & (channels<>4) THEN Error("-c <audiochannels> 1,2,4") END;

      ELSIF h[1]="Q" THEN
        NextArg(h);
        IF NOT StrToCard(h, owrxverb) THEN Error("-Q <lines>  (0)") END;
        verb:=TRUE;

      ELSIF h[1]="m" THEN
        NextArg(mccfilename);
        IF mccfilename[0]=0C THEN Error("-m <mcc-filename") END;

      ELSIF h[1]="w" THEN
        NextArg(h);
        soundfd:=createnonblockfile(h);
--        soundfd:=OpenWrite(h);

      ELSIF h[1]="j" THEN
        NextArg(h);
        jfd:=createnonblockfile(h);
        IF jfd<0 THEN Error("cannot create json file") END;

      ELSIF h[1]="J" THEN
        NextArg(h);
        IF GetIp(h, jipnum, jipport)<0 THEN Error("-J ip:port number") END;
        udpsock:=openudp();
        IF udpsock<0 THEN Error("-J udp socket open") END;

      ELSIF h[1]="W" THEN
        NextArg(h);
        IF ch<CHANS THEN
          chanfds[ch]:=createnonblockfile(h);
          IF chanfds[ch]>=0 THEN wwav(chanfds[ch], 8000, 1) ELSE Error("-W <soundfilename> cannot open sound output"); END;
          INC(ch);
        ELSE Error("-W  maximum 4 sound channels") END;

      ELSIF h[1]="i" THEN
        NextArg(iqfn);
        IF (iqfn[0]=0C) OR (iqfn[0]="-") THEN Error("-i <iqfilename>") END;

      ELSIF h[1]="f" THEN
        NextArg(h);
        IF (h[0]="i") & (h[1]="1") & (h[2]="6") THEN isize:=2
        ELSIF (h[0]="u") & (h[1]="8") THEN isize:=1
        ELSIF (h[0]="i") & (h[1]="8") THEN isize:=1; u8signed:=TRUE
        ELSIF (h[0]="f") & (h[1]="3") & (h[2]="2") THEN isize:=4
        ELSE Error("-f u8|i8|i16|f32") END;

      ELSIF h[1]="t" THEN
        NextArg(h);
        i:=0;
        num(n, h, i);
        tune:=n; 
        IF h[i]="," THEN INC(i); num(afclim, h, i) END;
        IF h[i]<>0C THEN Error("-t <+-Hz>[,<Hz>]") END;


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

      ELSIF h[1]="r" THEN
        NextArg(h);
        IF NOT StrToCard(h, insamprate) OR (insamprate<100) THEN Error("-r <samplerate-Hz>") END;

      ELSIF h[1]="d" THEN
        IF stored>0 THEN newmodem END;
        INC(stored);

        NextArg(h);
        ifwid:=20000;
        i:=0;
        num(fskbaud, h, i);
        IF h[i]="," THEN INC(i); num(ifwid, h, i) END;
        IF h[i]<>0C THEN Error("-d <sampelrate>,<if-width>") END;  

      ELSIF h[1]="h" THEN
        WrStrLn("");
        WrStrLn("  Demodulate DQPSK and decode tetra");
        WrStrLn("");
        WrStrLn(" -c             audio channels 1, 2 or 4, less than 4: mono/stereo downmix (2)");
        WrStrLn(" -d <baud>[,<if-widthHz>] (-d 18000,20000)");
        WrStrLn(" -f u8|i8|i16|f32   IQ data format (f32 slow)");
        WrStrLn(" -h                 this");
        WrStrLn(" -i <file>          IQ-filename or pipe from sdr receiver");
        WrStrLn(" -J <ipnum>:<port>  send metadata in JSON UDP");
        WrStrLn(" -j <file>          write metadata in JSON");
        WrStrLn(" -m <mcc-filename>  read file with 'mcc mnc text' lines");
        WrStrLn(" -O                 print raw demodulated bits to stdout");
        WrStrLn(" -Q <n>             reduce verbosity after <n> lines if no voice or no base station change by tuning");
        WrStrLn(" -r <Hz>            iq samplerate");
        WrStrLn(" -t <+-offsetHz>[,<afcHz>]");
        WrStrLn("                      Shift rx-frequency inside IQ band (avoid near 0 where is adc birdy) (0)");
        WrStrLn("                      afc-follow-range Hz, 90% in about 10ms, 0=afc off (0)");
        WrStrLn(" -V                 debug verbos");
        WrStrLn(" -v                 verbos");
        WrStrLn(' -u <mcc,mnc,colourcode> decoding uplink needs scrambler code seen by decoding downlink -v "CC" or give any number and decode a while downlink before uplink');
        WrStrLn(" -W <file/pipename> write wav file or unbreakable pipe with slot 0, repeat -W for slot 1 2 3");
        WrStrLn(" -w <file/pipename> write wav file or unbreakable pipe with -c channels downmixed and gain limited");
        WrStrLn("");

        WrStrLn("  mknod pipe.wav p");
        WrStrLn("  rtl_sdr -f 430.0m -s 2000000 -g 50 - | ./tetrarx -i /dev/stdin -f u8 -r 2000000 -t 87500,0 -w pipe.wav -m mccmnc.txt -c 2 -v");
        WrStrLn("  aplay a.wav");

        HALT
 
      ELSE err:=TRUE END;
    ELSE err:=TRUE END;
    IF err THEN EXIT END;
  END;
  IF err THEN Werr(">"); Werr(h); Werr("< use -h"+LF); HALT END;

  IF soundfd>=0 THEN wwav(soundfd, 8000, channels);
  ELSIF soundfd>=-1 THEN Error("-w <soundfilename> cannot open sound output"); END;

  IF insamprate=0 THEN Error("need input samplerate (-r)") END;
  newmodem;
END Parms;

-----------------tetradec


PROCEDURE readmccmnc;
VAR fp:INTEGER;
    c:CHAR;
    n, num, mn:CARDINAL;
    s:ARRAY[0..1000] OF CHAR;
    m:pMCC;
BEGIN
  IF mccfilename[0]=0C THEN RETURN END;

  fp:=OpenRead(mccfilename);
  IF fp>=0 THEN
    n:=0;
    num:=0;
    WHILE RdBin(fp, c, 1)=1 DO
      IF num<=1 THEN
        IF (c>="0") & (c<="9") THEN n:=n*10 + ORD(c) - ORD("0");
        ELSE
          INC(num);
          mn:=mn*65536 + n;  
          n:=0;
        END;
      ELSIF c>=" " THEN
        IF n<HIGH(s) THEN s[n]:=c; INC(n) END;
      ELSE
        IF mn<>0 THEN 
          IF n<=HIGH(s) THEN s[n]:=0C END;
          ALLOCATE(m, SIZE(m^));
          IF m=NIL THEN RETURN END;

          FILL(m, 0C, SIZE(m^));
          m^.mccmnc:=mn;
          Assign(m^.text, s);
          m^.next:=mcc;
          mcc:=m;
        END;
        num:=0;
        n:=0;
      END;
    END;
    Close(fp)
  ELSE WerrLn("mmc-file not readable") END;


  IF verb2 THEN
    m:=mcc;
    WHILE m<>NIL DO
      WrInt(m^.mccmnc DIV 65536,6);
      WrInt(m^.mccmnc MOD 65536,6);
      WrStr(" "); 
      WrStrLn(m^.text);
      m:=m^.next;
    END;
  END;
END readmccmnc;

PROCEDURE printmcc(mn:CARDINAL);
VAR s:ARRAY[0..99] OF CHAR;
    i:INTEGER;
BEGIN
  IF cachmn<>mn THEN
    cachpm:=mcc;
    WHILE (cachpm<>NIL) & (cachpm^.mccmnc<>mn) DO cachpm:=cachpm^.next END;
  END;
  cachmn:=mn;
  IF cachpm<>NIL THEN 
    Appj("COMPANY");
    Assign(s, cachpm^.text);
    FOR i:=0 TO VAL(INTEGER, Length(s))-1 DO 
      IF s[i]='"' THEN s[i]:="'" END;
    END; 
    Appjs(s);
    IF verbo(FALSE) THEN WrStr(" ["); WrStr(cachpm^.text); WrStr("]") END;
  END;
END printmcc;


--------- init reed muller decode

PROCEDURE RMinit;
CONST RM3014=ARRAY OF CARD8
        { 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0,
          0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0,
          1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
          1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0,
          1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 0,
          0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 1, 1, 0, 1, 1, 0,
          0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 1, 1, 0,
          1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1,
          1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1,
          0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1,
          0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1,
          0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1,
          0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 0, 1, 1,
          0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1};

VAR i,j:CARDINAL;
    b:SET32;
    rows:ARRAY[0..13] OF SET32;
BEGIN
  FOR i:=0 TO 13 DO
    b:=SHIFT(SET32{0}, VAL(INTEGER, i));
    FOR j:=0 TO 15 DO
      IF RM3014[j+16*i]>0 THEN INCL(b, 14+j) END;
    END;
    rows[i]:=b;
  END;
  FOR j:=0 TO HIGH(RMTAB) DO
    b:=SET32{};
    FOR i:=0 TO 13 DO
      IF (13-i) IN CAST(SET32, j) THEN b:=b/rows[i] END;
    END;
    RMTAB[j]:=b;
  END;
END RMinit;


PROCEDURE getscramb(mcc, mnc, colour:CARDINAL):SET32;   (*p.723*)
BEGIN
  RETURN SCRAMBINIT + SHIFT(
         CAST(SET32,colour)*SET32{0..5}
         + SHIFT(CAST(SET32,mnc)*SET32{0..13},6)
         + SHIFT(CAST(SET32,mcc)*SET32{0..9},20),2)
END getscramb;


PROCEDURE lim(u:INT16; VAR mul:REAL; lim:REAL):INT16;
CONST MAXG=20.0;
VAR r, ll:REAL;
BEGIN
  r:=VAL(REAL,u)*(MAXG-mul);
  ll:=ABS(r)-lim;
  IF ll>0.0 THEN mul:=mul+(MAXG-mul)*ll*0.00001;     (* too loud *)
  ELSE mul:=mul*0.9999 END;
  IF r>lim THEN r:=lim ELSIF r<-lim THEN r:=-lim END;
  RETURN VAL(INT16, r)
END lim;


PROCEDURE decodeaudio(frame-:ARRAY OF INT8; ch:CARDINAL);
VAR i,c,sp:CARDINAL;
    fw:ARRAY[0..DLEN-1] OF INT16;
    sb:ARRAY[0..ALEN*CHANS-1] OF INT16;

BEGIN
  IF ch>=CHANS THEN ch:=CHANS-1 END;
  IF audiobufs[ch].filled THEN            (* buffer filled and new data for this channel so dump sound *)
    sp:=0;
    FILL(ADR(sb), 0C, SIZE(sb));
    IF channels=1 THEN                    (* mix down to mono *)
      FOR i:=0 TO ALEN-1 DO
        FOR c:=0 TO HIGH(audiobufs) DO INC(sb[sp], lim(audiobufs[c].af[i], audiobufs[c].alc, 8000.0)) END;
        INC(sp);
      END;
    ELSIF channels=2 THEN                 (* mix down to stereo *)
      FOR i:=0 TO ALEN-1 DO
        INC(sb[sp], lim(audiobufs[0].af[i], audiobufs[0].alc, 16000.0));
        INC(sb[sp], lim(audiobufs[2].af[i], audiobufs[2].alc, 10600.0));
        INC(sb[sp], lim(audiobufs[3].af[i], audiobufs[3].alc, 5300.0));
        INC(sp);
        INC(sb[sp], lim(audiobufs[2].af[i], audiobufs[2].alc, 5300.0));
        INC(sb[sp], lim(audiobufs[3].af[i], audiobufs[3].alc, 10600.0));
        INC(sb[sp], lim(audiobufs[1].af[i], audiobufs[1].alc, 16000.0));
        INC(sp);
      END;
    ELSE
      FOR i:=0 TO ALEN-1 DO               (* 4 channel audio *)
        FOR c:=0 TO HIGH(audiobufs) DO
          sb[sp]:=lim(audiobufs[c].af[i], audiobufs[c].alc, 32000.0);
          INC(sp);
        END;
      END;
    END;
    WrBin(soundfd, sb, sp*2);
    Flush();
    FOR c:=0 TO HIGH(audiobufs) DO
      FILL(ADR(audiobufs[c].af), 0C, SIZE(audiobufs[c].af));
      audiobufs[c].filled:=FALSE;
    END;
  END;     

  FOR i:=0 TO HIGH(fw) DO fw[i]:=frame[i] END;                (* make 16 bit (but no soft viterbi) *)
  csdecoder.csdec(audiobufs[ch].af, fw);                      (* decode audio *)
  audiobufs[ch].filled:=TRUE;

  IF chanfds[ch]>=0 THEN WrBin(chanfds[ch], audiobufs[ch].af, ALEN*2) END; (* write single channel audio file *)
END decodeaudio;


VAR
    inlen,
    rdp:INTEGER;
    inb:ARRAY[0..4095] OF CHAR;

PROCEDURE frametyp(f-:ARRAY OF INT8; len:CARDINAL):CARDINAL;
CONST TRAINn=SET32{0,1,3,8,9,10,12,15,16,17,19};
      TRAINp=SET32{1,2,3,4,6, 9,14,15,17,18,19,20};
      TRAINy=SET32{0,1,7,8,11,12,13,16,17,18,20,23,24,25,31};
      TRAINy1=SET32{0,3,4,5};
      TRAINx=SET32{0,3,4,5,7,12,13,14,16,19,20,21,23,28,29};
      NOTFOUND=100;      

VAR i,m,j:CARDINAL;
    e:ARRAY[0..3] OF CARDINAL;
BEGIN
  e[0]:=0;
  e[1]:=0;
  e[2]:=0;
  e[3]:=0;
  IF len=510 THEN
    FOR i:=0 TO 21 DO
      IF (i IN TRAINn) <> (f[i+244]<0) THEN INC(e[0]) END;
      IF (i IN TRAINp) <> (f[i+244]<0) THEN INC(e[1]) END;
    END;
    FOR i:=0 TO 31 DO
      IF (i IN TRAINy) <> (f[i+214]<0) THEN INC(e[2]) END;
    END;
    FOR i:=0 TO 5 DO
      IF (i IN TRAINy1) <> (f[i+(214+32)]<0) THEN INC(e[2]) END;
    END;
  ELSE e[0]:=NOTFOUND; e[1]:=NOTFOUND; e[2]:=NOTFOUND; END;
  IF len=206 THEN
    FOR i:=0 TO 29 DO
      IF (i IN TRAINx) <> (f[i+88]<0) THEN INC(e[3]) END;
    END;
  ELSE e[3]:=NOTFOUND END;
  m:=NOTFOUND;
  j:=0;
  FOR i:=0 TO HIGH(e) DO
    IF e[i]<m THEN m:=e[i]; j:=i+1 END;
  END;
--WrStr("[");WrInt(m,1); WrStr("]");
  RETURN j
END frametyp;

PROCEDURE descramble(VAR buf:ARRAY OF INT8; reg:SET32; len:CARDINAL);
CONST P=SET32{0,6,9,10,16,20,21,22,24,25,27,28,30,31};
VAR i,j:CARDINAL;
    b:BOOLEAN;
    x:SET32;
BEGIN
  FOR i:=0 TO len-1 DO
    x:=reg*P;
    b:=FALSE;
    FOR j:=0 TO 31 DO
      IF j IN x THEN b:=NOT b END;
    END; 
    reg:=SHIFT(reg,-1);
    IF b THEN
      INCL(reg,31);
      buf[i]:=-buf[i];
    END;
  END;
END descramble; 


TYPE TYPS=(PUNCT23,PUNCT13,PUNCT292432,PUNCT148432,PUNCT112168,PUNCT72162,PUNCT3880);

PROCEDURE deinterleave(len, step:CARDINAL; in-:ARRAY OF INT8; VAR out:ARRAY OF INT8);
VAR i:CARDINAL;
BEGIN
  FOR i:=1 TO len DO out[i-1]:=in[(step*i) MOD len] END;
END deinterleave;

PROCEDURE depuncture(typ:TYPS; in-:ARRAY OF INT8; len:CARDINAL; VAR out:ARRAY OF INT8);
(*
0 120 p[1,2,5,9,10,13,17,18,21,25,26,29,33,34,37,41,42,45,49,50,53,57,58,61,65,66,69,73,74,77,81,82,85,89,90,93,97,98,101,105,106,109,113,114,117,121,122,125,129,130,133,137,138,141,145,146,149,153,154,157,161,162,165,169,170,173,177,178,181,185,186,189,193,194,197,201,202,205,209,210,213,217,218,221,225,226,229,233,234,237,241,242,245,249,250,253,257,258,261,265,266,269,273,274,277,281,282,285,289,290,293,297,298,301,305,306,309,313,314,317,]p
        0,1,4,8, 9,12,16,17,20,24,25,28,32,33,36,40,41,44,48,49,52,56,57,60,64,65,68,72,73,76,80,81,84,88,89,92,96,97,100,104,105,108,112,113,116,120,121,124,128,129,132,136,137,140,144,145,148,152,153,156,160,161,164,168,169,172,176,177,180,184,185,188,192,193,196,200,201,204,208,209,212,216,217,220,224,225,228,232,233,236,240,241,244,248,249,252,256,257,260,264,265,268,272,273,276,280,281,284,288,289,292,296,297,300,304,305,308,312,313,316,
        0,1,4,8, 9,12,16,17,20,24,25,28,32,33,36,40,41,44,48,49,52,56,57,60,64,65,68,72,73,76,80,81,84,88,89,92,96,97,100,104,105,108,112,113,116,120,121,124,128,129,132,136,137,140,144,145,148,152,153,156,160,161,164,168,169,172,176,177,180,184,185,188,192,193,196,200,201,204,208,209,212,216,217,220,224,225,228,232,233,236,240,241,244,248,249,252,256,257,260,264,265,268,272,273,276,280,281,284,288,289,292,296,297,300,304,305,308,312,313,316,


0 216 p[1,2,5,9,10,13,17,18,21,25,26,29,33,34,37,41,42,45,49,50,53,57,58,61,65,66,69,73,74,77,81,82,85,89,90,93,97,98,101,105,106,109,113,114,117,121,122,125,129,130,133,137,138,141,145,146,149,153,154,157,161,162,165,169,170,173,177,178,181,185,186,189,193,194,197,201,202,205,209,210,213,217,218,221,225,226,229,233,234,237,241,242,245,249,250,253,257,258,261,265,266,269,273,274,277,281,282,285,289,290,293,297,298,301,305,306,309,313,314,317,321,322,325,329,330,333,337,338,341,345,346,349,353,354,357,361,362,365,369,370,373,377,378,381,385,386,389,393,394,397,401,402,405,409,410,413,417,418,421,425,426,429,433,434,437,441,442,445,449,450,453,457,458,461,465,466,469,473,474,477,481,482,485,489,490,493,497,498,501,505,506,509,513,514,517,521,522,525,529,530,533,537,538,541,545,546,549,553,554,557,561,562,565,569,570,573,]p
        0,1,4,8, 9,12,16,17,20,24,25,28,32,33,36,40,41,44,48,49,52,56,57,60,64,65,68,72,73,76,80,81,84,88,89,92,96,97,100,104,105,108,112,113,116,120,121,124,128,129,132,136,137,140,144,145,148,152,153,156,160,161,164,168,169,172,176,177,180,184,185,188,192,193,196,200,201,204,208,209,212,216,217,220,224,225,228,232,233,236,240,241,244,248,249,252,256,257,260,264,265,268,272,273,276,280,281,284,288,289,292,296,297,300,304,305,308,312,313,316,320,321,324,328,329,332,336,337,340,344,345,348,352,353,356,360,361,364,368,369,372,376,377,380,384,385,388,392,393,396,400,401,404,408,409,412,416,417,420,424,425,428,432,433,436,440,441,444,448,449,452,456,457,460,464,465,468,472,473,476,480,481,484,488,489,492,496,497,500,504,505,508,512,513,516,520,521,524,528,529,532,536,537,540,544,545,548,552,553,556,560,561,564,568,569,572,
*)

TYPE ARR18=ARRAY[0..17] OF CARD8;
CONST PRATE23=ARR18 { 0, 1, 2, 5, 0, 0, 0, 0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0 };
CONST PRATE13=ARR18 { 0, 1, 2, 3, 5, 6, 7, 0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0 };
(* Voice *)
CONST PRATE812=ARR18 { 0, 1, 2, 4, 0, 0, 0, 0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0 };
CONST PRATE818=ARR18 { 0, 1, 2, 3, 4, 5, 7, 8, 10, 11,  0,  0,  0,  0,  0,  0,  0,  0 };
CONST PRATE817=ARR18 { 0, 1, 2, 3, 4, 5, 7, 8, 10, 11, 13, 14, 16, 17, 19, 20, 22, 23 };


VAR i,j,k,f,t,p,d:CARDINAL;
    P:ARR18;
BEGIN
  f:=MAX(CARDINAL);
  CASE typ OF
    PUNCT23:     P:=PRATE23; t:=3; p:=8;
   |PUNCT13:     P:=PRATE13; t:=6; p:=8;
   |PUNCT292432: P:=PRATE23; t:=3; p:=8; f:=65;
   |PUNCT148432: P:=PRATE13; t:=6; p:=8; f:=35;
   |PUNCT112168: P:=PRATE812; t:=3; p:=6;
   |PUNCT72162:  P:=PRATE818; t:=9; p:=12;
   |PUNCT3880:   P:=PRATE817; t:=17; p:=24;
  END;
  FILL(ADR(out), 0, SIZE(out));

--WrStrLn("");
  FOR j:=0 TO len-1 DO
    i:=j + j DIV f;
    d:=i DIV t;
    k:=p*d + VAL(CARDINAL, P[i+1 - t*d]);
    out[k-1]:=in[j];
--WrInt(k-1,1);WrStr(",");
  END;
--WrStrLn("");
END depuncture;

PROCEDURE viterbidec(VAR in:ARRAY OF INT8; len:CARDINAL; VAR out:ARRAY OF BYTE);
VAR ret:INTEGER;
    i:CARDINAL;
BEGIN
--  FOR i:=0 TO HIGH(in) DO in[i]:=0-in[i] END;
  ret:=conv_cch_decode(in, out, len);
END viterbidec;

PROCEDURE crc16(bits-:ARRAY OF BOOLEAN; len:CARDINAL):CARDINAL;
CONST POLY=SET32{0,5,12}; (* 0x1021*)
      START=SET32{0..15};
      TETRACRCOK=SET32{0,1,2,3,8,10,11,12};
VAR i:CARDINAL;
    c:SET32;
BEGIN
  c:=START;
  FOR i:=0 TO len-1 DO
    IF bits[i] THEN c:=c/SET32{15} END;
    IF 15 IN c THEN c:=SHIFT(c,1)/POLY ELSE c:=SHIFT(c,1) END;
  END;
  RETURN CAST(CARDINAL, c/TETRACRCOK*SET32{0..15})
END crc16;

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

PROCEDURE btoni(b-:ARRAY OF BOOLEAN; VAR from:CARDINAL; len:CARDINAL):CARDINAL;
VAR r:CARDINAL;
BEGIN
  r:=bton(b, from, len);
  INC(from, len);
  RETURN r
END btoni;

PROCEDURE showSBBLK1(b-:ARRAY OF BOOLEAN; len:CARDINAL; VAR cont:CONTEXT);
VAR mcc, mnc, cn, bc:CARDINAL;
    h,hh:ARRAY[0..30] OF CHAR;
BEGIN
  cont.tn:=bton(b, 10,2);
  cont.fn:=bton(b, 12,5);
  cont.mn:=bton(b, 17,6);
  mcc:=bton(b, 31,10);
  mnc:=bton(b, 41,14);
  bc:=bton(b, 4,6);
  cn:=mcc*65536 + mnc;
  IF ABS(scanoffs-cont.offset)<SCANTOL THEN
    IF (cont.mccmnc=cn) & (cont.bcc=bc) THEN INC(cont.ccc) ELSE cont.ccc:=0 END;
  END;
  IF cont.mccmnc<>cn THEN owrxlastvoice:=0 END;   (* tuned so fast print new values *)
  cont.mccmnc:=cn;
  cont.bcc:=bc;
  cont.xor:=getscramb(mcc, mnc, cont.bcc);
  Appj("TN"); Appjc(cont.tn);
  Appj("FN"); Appjc(cont.fn);
  Appj("MN"); Appjc(cont.mn);
  Appj("CC");
  CardToStr(mcc,1,h); Append(h,","); CardToStr(mnc,1,hh); Append(h,hh); Append(h,","); CardToStr(cont.bcc,1,hh); Append(h,hh);
  Appjs(h);
  IF verbo(FALSE) THEN 
    WrStr(" TN="); WrCard(cont.tn,1); 
    WrStr(" FN="); WrCard(cont.fn,2);
    WrStr(" MN="); WrCard(cont.mn,1);
--    WrStr(" MCC="); WrCard(mcc,1);
--    WrStr(" MNC="); WrCard(mnc,1);
    WrStr(" CC=");
    WrCard(mcc,1); WrStr(",");
    WrCard(mnc,1); WrStr(",");
    WrCard(cont.bcc,1);
    WrStr(" ");
  END;
END showSBBLK1;

PROCEDURE showNDB(b-:ARRAY OF BOOLEAN; len:CARDINAL);
BEGIN
  IF verbo(TRUE) THEN WrStrLn(" NDB") END;
END showNDB;

PROCEDURE showSCHf(b-:ARRAY OF BOOLEAN; len:CARDINAL);
CONST LEN=ARRAY OF CARD8 {0,24,10,24,34,34,30,34};
VAR p,type,n,styp,ssi,usagemarker:CARDINAL;
BEGIN

--WrStr(" ----B["); WrInt(bton(b,0,4),1); WrStrLn("]");

  type:=btoni(b, p, 2);                  (* p613 p380 *)
  Appj("MAC");Appjc(type);
  p:=0;
  IF verbo(FALSE) THEN WrStr(" MAC=");WrCard(type,1) END;
  IF type=0 THEN
    n:=btoni(b, p, 2);
    n:=btoni(b, p, 2);
    n:=btoni(b, p, 1);
    n:=btoni(b, p, 6);
    styp:=btoni(b, p, 3);
    usagemarker:=0;
    IF styp>0 THEN 
      IF styp=3 THEN Appj("ussi") ELSE Appj("ssi") END;
      IF verbo(FALSE) THEN
        IF styp=3 THEN WrStr(" ussi=") ELSE WrStr(" ssi=") END;
      END;
      Appjc(styp);
      IF verbo(FALSE) THEN WrCard(styp,1) END;
      ssi:=btoni(b, p, LEN[styp]);
      IF styp=6 THEN usagemarker:=ssi MOD 64; ssi:=ssi DIV 64 END;
      IF verbo(FALSE) THEN
        WrStr(":");WrCard(ssi,1);
        IF styp=6 THEN WrStr(" um:");WrCard(usagemarker,1); END;
      END;
    END;
  END;
  IF verbo(FALSE) THEN WrStr(" ") END;
END showSCHf;

PROCEDURE showSBBLK2(b-:ARRAY OF BOOLEAN; len:CARDINAL; VAR cont:CONTEXT);
CONST OFFS=ARRAY OF REAL {0.0, -6.25, 6.25, 12.5};
      DUPLEX=ARRAY OF INTEGER {
         -1, 1600, 10000, 10000, 10000, 10000, 10000, -1, -1, -1, -1, -1, -1, -1, -1, -1,
         -1, 4500, -1, 36000, 7000, -1, -1, -1, 45000, 45000, -1, -1, -1, -1, -1, -1,
          0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
         -1, -1, -1, 8000, 8000, -1, -1, -1, 18000, 18000, -1, -1, -1, -1, -1, -1,
         -1, -1, -1, 18000, 5000, -1, 30000, 30000, -1, 39000, -1, -1, -1, -1, -1, -1,
         -1, -1, -1, -1, 9500, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1 };

VAR i,band,ch, offs, duplexspacing, revers, ncsh, mspwr, rxlev, accparm,rtimeout,
    norf, cckid, hyperframenr, subscrclass, la, adrtyp:CARDINAL;
    bsservicedetails:SET32;
    shift:INTEGER;
    rh:REAL;   
BEGIN

--WrStr("B[");  FOR i:=0 TO len-1 DO WrInt(ORD(b[i]),1) END; WrStrLn("]");

--WrStr(" ----B["); WrInt(bton(b,0,4),1); WrStrLn("]");

  IF bton(b,0,4)=8 THEN   (* SYSINFO p623 *)
    i:=4;
    ch:=btoni(b, i, 12);
    band:=btoni(b, i, 4);
    offs:=btoni(b, i, 2);
    duplexspacing:=btoni(b, i, 3);
    revers:=btoni(b, i, 1);
    ncsh:=btoni(b, i, 2);
    mspwr:=btoni(b, i, 3);
    rxlev:=btoni(b, i, 4);
    accparm:=btoni(b, i, 4);
    rtimeout:=btoni(b, i, 4);
    norf:=btoni(b, i, 1);
    IF norf>0 THEN cckid:=btoni(b, i, 16) ELSE hyperframenr:=btoni(b, i, 16) END;
    i:=124-42;
    la:=btoni(b, i, 14);                            (* p1172 *)
    IF ABS(scanoffs-cont.offset)<SCANTOL THEN
      IF cont.la=la THEN INC(cont.lac) ELSE cont.lac:=0 END;
    END;
    IF la<>cont.la THEN owrxlastvoice:=0 END;   (* tuned so fast print new values *)
    cont.la:=la;
    subscrclass:=btoni(b, i, 16);
    bsservicedetails:=CAST(SET32, btoni(b, i, 12));
 
    shift:=DUPLEX[band+duplexspacing*16];
    cont.dmhz:=(FLOAT(band*100000 + ch*25) + OFFS[offs])*0.001;
    owrxhasvoice:=(5 IN bsservicedetails) & NOT (1 IN bsservicedetails);                (* not encrypted and voice service *)
    Appj("TX"); Appjf(cont.dmhz,5);

    IF shift>=0 THEN
      IF revers>0 THEN shift:=-shift END;
      rh:=(FLOAT(band*100000 + ch*25) + OFFS[offs] - FLOAT(shift))*0.001;
      Appj("RX"); Appjf(rh,5);
    END;
    Appj("Po"); Appjc(mspwr*5+10);
    Appj("LA"); Appjc(cont.la);
    Appj("VOICE");Appjc(ORD(5 IN bsservicedetails));
    Appj("ENC"); Appjc(ORD(1 IN bsservicedetails));
    IF verbo(FALSE) THEN
      WrStr("TX="); WrFixed(cont.dmhz,4,1);
      IF shift>=0 THEN WrStr(" RX="); WrFixed(rh,4,1) END;
      WrStr(" Po="); WrCard(mspwr*5+10,1); WrStr("dBm");
      WrStr(" LA="); WrCard(cont.la,1);
      IF NOT (5 IN bsservicedetails) THEN WrStr(" No Voice Service") END;
      IF 1 IN bsservicedetails THEN WrStr(" Air-encrypt") END;
    END;
    printmcc(cont.mccmnc);

  ELSIF bton(b,0,2)=0 THEN   (* MAC RESOURCE p612 *)
--    WrStr(" ----B["); WrInt(bton(b,13,3),1); WrStrLn("]");
    adrtyp:=bton(b,13,3);
    Appj("ADRTYP"); Appjc(adrtyp);
    IF adrtyp=1 THEN Appj("SSI"); Appjc(bton(b,16,24)); (* ASSI p739 p356 *) 
    ELSIF adrtyp=3 THEN Appj("USSI"); Appjc(bton(b,16,24));;
    ELSIF adrtyp=4 THEN Appj("SMI"); Appjc(bton(b,16,24));
    END;
    IF verbo(FALSE) THEN
      IF adrtyp=1 THEN WrStr(" SSI="); WrCard(bton(b,16,24),1); (* ASSI p739 p356 *) 
      ELSIF adrtyp=3 THEN WrStr(" USSI="); WrCard(bton(b,16,24),1);
      ELSIF adrtyp=4 THEN WrStr(" SMI="); WrCard(bton(b,16,24),1);
      ELSIF adrtyp=6 THEN
        WrStr(" USSI/UM=");
        WrCard(bton(b,16,30) DIV 64,1);
        WrStr(":");
        WrCard(bton(b,16,30) MOD 64,1);
      ELSE WrStr(" ADRTYP:"); WrCard(adrtyp,1);WrStr(":");WrCard(bton(b,16,24),1) END;
    END;

  ELSIF bton(b,0,4)=9 THEN   (* 9 MAC RESOURCE p631 *)
    Appj("GSSI"); Appjc(bton(b,29,24));
    IF verbo(FALSE) THEN
WrStr(" ACCESS-DEF:"); WrInt(bton(b,27,2),1);
      IF (bton(b,27,2)=2) THEN (* 2 *)            
        WrStr(" GSSI=");
--WrCard(bton(b,27,2),1); WrStr(":");
--WrCard(bton(b,0,4),1); WrStr(":");
--        WrCard(bton(b,45,24),1);
        WrCard(bton(b,29,24),1);
      END;
    END; 
  END;

END showSBBLK2;

PROCEDURE SCHf(b-:ARRAY OF BOOLEAN; type4-:ARRAY OF INT8; len, slot:CARDINAL);
VAR i:CARDINAL;
    block:ARRAY[0..689] OF INT16;
    tmpstr:ARRAY[0..1380+13-1] OF CHAR;
BEGIN
--WrStr("S[");  FOR i:=0 TO len-1 DO WrInt(ORD(b[i]),1) END; WrStrLn("]");
  IF slot>3 THEN slot:=3 END;
  IF owrxhasvoice THEN owrxlastvoice:=0 END; (* voice out running *)
  voicenow:=0;
  IF (chanfds[0]>=0) OR (soundfd>=0) THEN               (* else save cpu *)
    decodeaudio(type4, slot);
  END;
END SCHf;

PROCEDURE decodeRM(inb-:ARRAY OF INT8; VAR outb:ARRAY OF BOOLEAN):CARDINAL;
CONST B=ARRAY OF CARD8 {0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,
                        3,4,4,5,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,
                        3,4,4,5,4,5,5,6,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,
                        3,4,4,5,3,4,4,5,4,5,5,6,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,
                        3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,1,2,2,3,2,3,3,4,2,3,3,4,
                        3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,2,3,3,4,3,4,4,5,
                        3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,2,3,3,4,
                        3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,
                        3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8}; (* number of ones in a byte *)
      M8=SET32{0..7};
VAR i, j, min, best, errs:CARDINAL;
    in, out:SET32;
BEGIN
  in:=SET32{};
  i:=0;
  REPEAT
    IF inb[i]<=0 THEN INCL(in, i) END;
    INC(i);
  UNTIL i>=30;

--in:=in/SET32{2,12,17};  (* apply error *)

  out:=in*SET32{0..13};
--WrStr("B[");  FOR i:=0 TO 29 DO WrCard(ORD(i IN in),1) END; WrStrLn("]");
--WrStr("O[");  FOR i:=0 TO 31 DO WrCard(ORD(i IN out),1) END; WrStrLn("]");

  IF RMTAB[CAST(CARDINAL, out)]<>in THEN    (* save cpu if no error else try to correct *)
    best:=0;
    min:=MAX(CARDINAL);
    i:=0;
    REPEAT                                  (* find best fitting RM code by stupid search *)
      out:=RMTAB[i]/in;
      errs:=B[CAST(CARDINAL,out*M8)]
           +B[CAST(CARDINAL,CAST(SET32,ASH(CAST(CARDINAL,out),-8))*M8)]
           +B[CAST(CARDINAL,CAST(SET32,ASH(CAST(CARDINAL,out),-16))*M8)]
           +B[CAST(CARDINAL,CAST(SET32,ASH(CAST(CARDINAL,out),-24)))];      (* fast error bits counter *)
      IF errs<min THEN min:=errs; best:=i END;
      INC(i);
    UNTIL i>HIGH(RMTAB);
    out:=CAST(SET32, best);
  ELSE min:=0 END;

  FOR i:=0 TO 13 DO outb[13-i]:=i IN out END;

  IF verbo(FALSE) & (min>0) THEN WrStr(" RM-corr="); WrCard(min,1); WrStr(" ") END;
--WrStr("D[");  FOR i:=0 TO 13 DO WrCard(ORD(outb[i]),1) END; WrStrLn("]");
  RETURN ORD(min>3)
END decodeRM;


PROCEDURE showBB(b-:ARRAY OF BOOLEAN; VAR cont:CONTEXT);  (* p. 634 *)
VAR head, f1, f2, i:CARDINAL;
BEGIN
  head:=bton(b, 0,2);
  f1:=bton(b,2,6);
  f2:=bton(b,8,6);
  cont.istrafic:=FALSE;
--WrInt(cont.fn,1);WrStr("B[");  FOR i:=0 TO 13 DO WrCard(ORD(b[i]),1) END; WrStrLn("]");
--  IF cont.fn=18 THEN


--  ELSE
    IF ODD(head) THEN (* downlink usage *)
--WrStr("DL-Usage=");WrCard(f1, 1); WrStr(" ");
      cont.istrafic:=f1>=4;
--      cont.istrafic:=TRUE;
--    END; 
  END;
END showBB;


PROCEDURE decode(fr:ARRAY OF INT8; start, len:CARDINAL; VAR cont:CONTEXT; ftyp:CARDINAL);
VAR i, vitlen, crclen, deint:CARDINAL;
    b,bd:ARRAY[0..509] OF INT8;
    bdp:ARRAY[0..2000] OF INT8;
    bdv:ARRAY[0..2000] OF BOOLEAN;
    crcok:CARDINAL;
BEGIN
  FOR i:=0 TO len-1 DO b[i]:=fr[i+start] END;

  IF len=SBBLK1BITS THEN vitlen:=80; crclen:=60; deint:=11;
  ELSIF len=SBBLK2BITS THEN vitlen:=144; crclen:=124; deint:=101;
  ELSIF len=SBBBKBITS THEN vitlen:=0; crclen:=0;
  ELSIF len=NDBBLKBITS+NDBBLKBITS THEN vitlen:=288; crclen:=268; deint:=103;
  END;
--WrStr(" len=");WrCard(len,1);

--WrStr(" xor="); WrCard(CAST(CARDINAL, xor),1); WrStrLn("");
  descramble(b, cont.xor, len);
  IF len=SBBBKBITS THEN  (* reed muller *)
    crcok:=decodeRM(b, bdv);
    showBB(bdv, cont);  
  ELSE
    deinterleave(len, deint, b, bd); 
    depuncture(PUNCT23, bd, len, bdp);
--WrStr("d[");  FOR i:=0 TO len DO WrInt(bd[i],1); WrStr(" "); END; WrStrLn("]");
    viterbidec(bdp, vitlen, bdv);
--WrInt(vitlen,1);WrStr(" v[");  FOR i:=0 TO vitlen-1 DO WrInt(ORD(bdv[i]),1); END; WrStrLn("]");
    crcok:=crc16(bdv,crclen+16);
--IF verbo(FALSE) THEN WrStr(" CRC:");
--  IF crcok=0 THEN WrStr("Ok ") ELSE WrCard(crcok,1); WrStr(" ") END;
--END;
    IF crcok=0 THEN
      IF len=SBBLK1BITS THEN showSBBLK1(bdv, crclen, cont);    (* p630 *)
      ELSIF len=SBBLK2BITS THEN 
        showSBBLK2(bdv, crclen, cont);
        IF ftyp=2 THEN showSCHf(bdv, crclen) END; 
      ELSIF len=NDBBLKBITS+NDBBLKBITS THEN showSCHf(bdv, crclen);
--      ELSIF len=NDBBLKBITS THEN showNDB(bdv, crclen);
      END;
    END;
    IF (len=NDBBLKBITS+NDBBLKBITS) & (isuplink OR cont.istrafic) THEN
      SCHf(bdv, b, crclen, cont.tn);
      IF verbo(FALSE) THEN WrStr(" Data["); WrCard(context.fn,1); WrStr("/"); WrCard(context.tn,1);WrStr("]") END;
    END;
  END;
END decode;


VAR
    dat:ARRAY[0..509] OF CHAR;
    fb:ARRAY[0..509] OF INT8;

PROCEDURE decodefr(fr-:ARRAY OF INT8; frlen:CARDINAL);
VAR i, typ:CARDINAL;
BEGIN
--  IF verbo(FALSE) THEN
--        WrFixed(context.db, 1,1); WrStr("dB ");
--        WrInt(context.offset, 1); WrStr("Hz ");
--  END;
  typ:=frametyp(fr, frlen);        
--  IF verb THEN WrStr("FT="); WrCard(typ,1); WrStr(" ") END;        
  IF typ=3 THEN
    context.xor:=SCRAMBINIT;
    decode(fr, (6+1+40)*D4BITS, SBBLK1BITS, context, 3);
    decode(fr, (6+1+40+60+19)*D4BITS, SBBBKBITS, context, 3);
    decode(fr, (6+1+40+60+19+15)*D4BITS, SBBLK2BITS, context, 3);
    IF verbo(TRUE) THEN WrStrLn("") END;

  ELSIF typ=2 THEN
    IF isuplink THEN
      decode(fr, UNDBBLK1OFFSET, NDBBLKBITS, context, 2);
      decode(fr, UNDBBLK2OFFSET, NDBBLKBITS, context, 2);
    ELSE
      (* re-combine the broadcast block *)
      FOR i:=0 TO NDBBBK1BITS-1 DO fb[i]:=fr[i+NDBBBK1OFFSET] END;
      FOR i:=0 TO NDBBBK2BITS-1 DO fb[i+NDBBBK1BITS]:=fr[i+NDBBBK2OFFSET] END;
      decode(fb, 0, SBBBKBITS, context, 2);
      decode(fr, NDBBLK1OFFSET, NDBBLKBITS, context, 2);
      decode(fr, NDBBLK2OFFSET, NDBBLKBITS, context, 2);
    END;
    IF verbo(TRUE) THEN WrStrLn("") END;

  ELSIF typ=1 THEN (* SCH/F *)
    IF NOT isuplink THEN INC(context.tn) END;
    IF context.tn>3 THEN context.tn:=0; context.fn:=context.fn MOD 18+1 END;
    IF isuplink THEN
--WrStr("u[");  FOR i:=0 TO frlen-1 DO WrInt(ORD(fr[i]<0),1); END; WrStrLn("]");
      FOR i:=0 TO NDBBLKBITS-1 DO fb[i]:=fr[i+UNDBBLK1OFFSET] END;
      FOR i:=0 TO NDBBLKBITS-1 DO fb[i+NDBBLKBITS]:=fr[i+UNDBBLK2OFFSET] END;
      decode(fb, 0, NDBBLKBITS+NDBBLKBITS, context, 1);
    ELSE
      (* re-combine the broadcast block *)
      FOR i:=0 TO NDBBBK1BITS-1 DO fb[i]:=fr[i+NDBBBK1OFFSET] END;
      FOR i:=0 TO NDBBBK2BITS-1 DO fb[i+NDBBBK1BITS]:=fr[i+NDBBBK2OFFSET] END;
      decode(fb, 0, SBBBKBITS, context, 1);
      FOR i:=0 TO NDBBLKBITS-1 DO fb[i]:=fr[i+NDBBLK1OFFSET] END;
      FOR i:=0 TO NDBBLKBITS-1 DO fb[i+NDBBLKBITS]:=fr[i+NDBBLK2OFFSET] END;
      decode(fb, 0, NDBBLKBITS+NDBBLKBITS, context, 1);
    END;
    IF verbo(TRUE) THEN WrStrLn("") END;
  ELSE
    IF verbo(TRUE) THEN WrStrLn("") END
  END;
  IF ABS(scanoffs-context.offset)<SCANTOL THEN rxany:=TRUE END;
END decodefr;


-----------------tetradec end
 
PROCEDURE lp(in:REAL; VAR c:LPCONTEXT24);     (* lowpass 24db/oct 6dB loss *)
BEGIN
  WITH c DO
    uc1:=uc1 + (in-uc1)*LPR - il;
    uc2:=uc2*OLPR + il;
    il:=il + (uc1-uc2)*LPL;
  END;  (* result is uc2 *)
END lp;


PROCEDURE errlim(s:SET32; lim:CARDINAL):BOOLEAN;                                    (* fast count 1 in a bitset *)
CONST B=ARRAY OF CARD8 {0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,
                        3,4,4,5,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,
                        3,4,4,5,4,5,5,6,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,
                        3,4,4,5,3,4,4,5,4,5,5,6,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,
                        3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,1,2,2,3,2,3,3,4,2,3,3,4,
                        3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,2,3,3,4,3,4,4,5,
                        3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,2,3,3,4,
                        3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,
                        3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8};
VAR c:CARDINAL; 
BEGIN
  c:=B[CAST(CARDINAL, s*SET32{0..7})];
  IF c>lim THEN RETURN FALSE END;

  INC(c, B[CAST(CARDINAL, SHIFT(s, -8)*SET32{0..7})]);
  INC(c, B[CAST(CARDINAL, SHIFT(s, -16)*SET32{0..7})]);
  INC(c, B[CAST(CARDINAL, SHIFT(s, -24))]);
  RETURN c<=lim
END errlim;


---------------------- D4PSK


PROCEDURE d4pskframe(fb-:ARRAY OF INT8; flen:CARDINAL; VAR m:DQPSKMODEM);
VAR i:CARDINAL;
    d,afchz:REAL;
    dat:ARRAY[0..509] OF CHAR;
    jh:ARRAY[0..999] OF CHAR;
    offs, ret:INTEGER;
BEGIN
  jline[0]:=0C;
--  offs:=VAL(INTEGER, (VAL(REAL, VAL(INT16,m.iffreqc))+0.0*m.pllf*PLLGAIN*m.ddsbase)/m.ddsbase);
  offs:=VAL(INTEGER, (VAL(REAL, VAL(INT16,m.iffreqc)))/m.ddsbase);

  IF flen>1 THEN

    afchz:=(m.pllf*PLLGAIN*m.ddsbase+VAL(REAL, m.croase))/m.ddsbase;
    d:=dB(m.rflevel)*0.5-90;
    decodefr(fb, flen);

    Appj("FTYP"); Appjc(m.ftyp);
    Appj("AFC"); Appji(VAL(INTEGER,afchz));
    Appj("EYE"); Appji(VAL(INTEGER,(0.5-m.qual)*200.0));
    Appj("dB"); Appjf(d,3);
    Appj("len");Appjc(flen);
    Appj("AUDIO"); Appjc(ORD(voicenow<8));
    INC(voicenow);
    IF jline[0]<>0C THEN  
      Assign(jh,"{"); Append(jh,jline); Append(jh,"}"+LF);
      IF jfd>=0 THEN  WrBin(jfd, jh, Length(jh)) END;
      IF udpsock>=0 THEN ret:=udpsend(udpsock, jh, Length(jh), jipport, jipnum) END;
    END;
IF verbo(FALSE) THEN
  WrStr("Tetra:");
--  WrCard(m.modemnum,1);
--  WrStr(" fr:");
  WrCard(m.ftyp,1);
--  WrStr(" offs:"); WrInt(VAL(INTEGER, VAL(REAL, VAL(INT16,m.iffreq))/m.ddsbase),1); WrStr("Hz");
  IF owrxverb=0 THEN WrStr(" offs:"); WrInt(offs,1); WrStr("Hz") END;
  WrStr(" afc:"); WrInt(VAL(INTEGER,afchz),1); WrStr("Hz");
  WrStr(" eye:"); WrInt(VAL(INTEGER,(0.5-m.qual)*200.0),1); WrStr("% ");
  WrFixed(d,1,5); WrStr("dB ");
  WrStr("len:");WrInt(flen,1);
  IF verb2 THEN
    WrStr(" [");
    FOR i:=0 TO flen-1 DO dat[i]:=CHR(ORD(fb[i]>=0)+ORD("0")) END;
    IF flen<=HIGH(dat) THEN dat[flen]:=0C END;  
    WrStr(dat);
    WrStrLn("]");
  END;
--WrFixed(VAL(REAL,m.croase)/m.ddsbase,1,1); WrStr("Hz ");
--IF (flen=206) & fb[0] & fb[1] & NOT fb[2] & NOT fb[3] & fb[202] & fb[203] & NOT fb[204] & NOT fb[205] THEN WrStr(" uplink burst") END;
END;
  END;

END d4pskframe;


PROCEDURE d4psksymb(w:REAL; VAR m:DQPSKMODEM);
(* continous downlink  1,0, 1,1, 0,1, 1,1, 0,0,   0,0, 0,1, 1,0, 1,0, 1,1, 0,1*)
CONST
      FULLLEN=510;
      CONTROLLEN=206;
      TRAIN1=SET32{2,4,5,6,9,11,12,13,18,20,21};
      TRAIN1MASK=SET32{0..21};
      TRAIN1END=FULLLEN-266;

      TRAIN2=SET32{1,2,3,4,6,7,12,15,17,18,19,20};
      TRAIN2MASK=SET32{0..21};
      TRAIN2END=FULLLEN-266;

      TRAIN3=SET32{0,2,3,5,7,8,14,15,16,18,19,21};
      TRAIN3MASK=SET32{0..21};
      TRAIN3END=FULLLEN-266;
--1011010110 000011101101

      TRAINX=SET32{0,1,6,8,9,10,13,15,16,17,22,24,25,26,29};
      TRAINXMASK=SET32{0..29};
      TRAINXEND=206-118;

      TRAINSL=SET32{0,1,2,5,6,12,13,14,17,19,20,21,24,25,26,29,30};
      TRAINSH=SET32{4,5};
      TRAINSHMASK=SET32{0..5};
      TRAINSEND=FULLLEN-252;


--(1,1, 0,0, 0,0, 0,1, 1,0, 0,1, 1,1, 0,0, 1,1, 1,0, 1,0, 0,1, 1,1, 0,0, 0,0, 0,1, 1,0, 0,1, 1,1)

--110000101110010111000010111001
--    0010111001011100001011

   
--      TRAIN2=SET32{1,2,3,4,6,7,12,15,17,18,19,20};
--      TRAIN2MASK=SET32{0..21};
--      TRAIN1=SET32{2,4,5,6,9,11,12,13,18,20,21};
--      TRAIN1MASK=SET32{0..21};
--      TRAINSYN=ARRAY OF CARD8{1,1,0,0,0,0,0,1,1,0,0,1,1,1,0,0,1,1,1,0,1,0,0,1,1,1,0,0,0,0,0,1,1,0,0,1,1,1};
--      TRAIN1=ARRAY OF CARD8{1,1,0,1,0,0,0,0,1,1,1,0,1,0,0,1,1,1,0,1,0,0};
--      TRAIN2=ARRAY OF CARD8{0,1,1,1,1,0,1,0,0,1,0,0,0,0,1,1,0,1,1,1,1,0};

VAR d, dd:CARD8;
    soft:INT8;
    i, flen:CARDINAL;
    e:SET32;
    bit0, bit1, ok:BOOLEAN;
    fb:ARRAY[0..FULLLEN-1] OF INT8;

BEGIN
  d:=VAL(CARD8, w);
  dd:=(d-m.lastd) MOD 4;
  m.lastd:=d;
  soft:=VAL(INT8, (w-FLOAT(d))*127.0);
  m.synwh:=SHIFT(m.synwh,2)+SHIFT(m.synw,-30); 
  m.synw:=SHIFT(m.synw,2);
  CASE dd OF
     0:m.fifo[m.fifop]:=127-soft;
       m.fifo[m.fifop+1]:=soft;
    |1:m.fifo[m.fifop]:=-soft;
       m.fifo[m.fifop+1]:=127-soft;
       INCL(m.synw,1);
    |2:m.fifo[m.fifop]:=soft-127;
       m.fifo[m.fifop+1]:=-soft;
       INCL(m.synw,0);
       INCL(m.synw,1);
  ELSE m.fifo[m.fifop]:=soft;
       m.fifo[m.fifop+1]:=soft-127;
       INCL(m.synw,0);
  END;
  m.fifop:=(m.fifop+2) MOD (HIGH(m.fifo)+1);
 
  IF errlim(m.synw/TRAINSL,1) & errlim((m.synwh*TRAINSHMASK)/TRAINSH,1) THEN 
    m.ftyp:=3;
    m.fend:=m.fifop+TRAINSEND;
--WrStr("syn3:");WrCard(testc,1); WrStrLn("");
  ELSIF errlim((m.synw*TRAINXMASK)/TRAINX,2) THEN
    m.ftyp:=4;
    m.fend:=m.fifop+TRAINXEND;
--WrStr("syn4:");WrCard(testc,1); WrStrLn("");
  ELSIF errlim((m.synw*TRAIN1MASK)/TRAIN1,0) THEN
    m.ftyp:=1;
    m.fend:=m.fifop+TRAIN1END;
--WrStr("syn1:");WrCard(testc,1); WrStrLn("");
  ELSIF errlim((m.synw*TRAIN2MASK)/TRAIN2,0) THEN
    m.ftyp:=2;
    m.fend:=m.fifop+TRAIN2END;
--WrStr("syn2:");WrCard(testc,1); WrStrLn("");
  END;
  IF (m.ftyp>0) & (m.fend MOD (HIGH(m.fifo)+1)=m.fifop) THEN
    flen:=FULLLEN;
    IF m.ftyp=4 THEN flen:=CONTROLLEN END;
--WrStrLn("");
    FOR i:=0 TO flen-1 DO fb[i]:=m.fifo[(i+(HIGH(m.fifo)+1)+m.fifop-flen) MOD (HIGH(m.fifo)+1)];
--WrInt(ORD(m.fifo[i]),1);
 END;
--WrStrLn("");
    d4pskframe(fb, flen, m);
    m.ftyp:=0;
  END;

END d4psksymb;


PROCEDURE sampled4psk(ire, iim:INTEGER; VAR m:DQPSKMODEM);
CONST DLLSPEED=32;  (* 32 *)
      AFCTHRES=0.1; (* 0.1 *)
VAR c, dm:CARDINAL;
    si, co, lev, w:REAL;
    isi, ico:INTEGER;
    s:Complex;
BEGIN
  isi:=DDS[m.ifosc MOD DDSLEN];
  ico:=DDS[(m.ifosc+DDSLEN DIV 4) MOD DDSLEN];
  INC(m.ifosc, m.iffreqc);
  lp(FLOAT(iim*ico - ire*isi), m.iflpq);
  lp(FLOAT(ire*ico + iim*isi), m.iflpi);
  c:=m.ifsamp;
  dm:=m.ifstep;
  IF m.dir>0 THEN INC(dm, m.ifstep DIV DLLSPEED)
  ELSIF m.dir<0 THEN DEC(dm, m.ifstep DIV DLLSPEED) END;
  m.dir:=0;
  INC(m.ifsamp, dm);                         (* wrap around 32bit *)
  IF m.ifsamp<c THEN                         (* input samplerate down to if-samplerate *)

    s.Re:=m.iflpq.uc2;
    s.Im:=m.iflpi.uc2;

    lev:=s.Re*s.Re + s.Im*s.Im;              (* gain for symbol sync and measurement *)

    w:=fmhighpass(atan2(s), m.fmo);          (* fm demod for wide range afc *)
    m.fm:=m.fm+(w-m.fm)*0.001;               (* fm lowpass *)

    IF (ABS(m.fm)>AFCTHRES) & (ABS(m.croase)<m.maxcroase) THEN (* croase afc threshold and in limit *)
      IF m.fm>=0.0 THEN DEC(m.croase, TRUNC(1000.0*m.ddsbase)) 
      ELSE INC(m.croase, TRUNC(1000.0*m.ddsbase)) END;
      m.fm:=0.0;
--      IF m.croase>m.afclimit THEN m.croase:=m.afclimit;
--      ELSIF m.croase<-m.afclimit THEN m.croase:=-m.afclimit END;
    END;

    IF m.state=0 THEN m.lev1:=lev;           (* 1/4 symboltime level *)
    ELSIF m.state=1 THEN m.lowlev:=lev;      (* middle between 2 symbols *)
    ELSIF m.state=2 THEN m.lev2:=lev;        (* 3/4 symbol time *)
    ELSE
      IF (m.olev+lev)*0.43>m.lowlev THEN     (* 0.45 big fase jump used for adjust symbol sync *)
        m.dir:=ORD(m.lev1<m.lev2)*2-1;       (* move symbol sample time *)
      END;

--smeter
      m.rflevel:=m.rflevel+(lev-m.rflevel)*0.02;
      m.olev:=lev;

--symbol phase 0.0..4.0 + pi/8 shift remove
      w:=atan2(s)*(2.0/PI) + 2.0 + FLOAT(m.pllosc)*0.5;
      m.pllosc:=(m.pllosc+1) MOD 8;
      IF w<0.0 THEN w:=w+4.0 ELSIF w>4.0 THEN w:=w-4.0 END;
      d4psksymb(w, m);

----carrier pll
      w:=w-VAL(REAL, VAL(INTEGER,w))-0.5;    (* -0.5..0.5 phase error *)
      m.qual:=m.qual*0.975+ABS(w)*0.025; (* 0.025 *) 
      m.pllf:=m.pllf - w*0.15;
      m.plllag:=m.plllag+(m.pllf-m.plllag)*0.05;  (* 0.05 0.02 for dx *) (* lead lag pll loopfilter *)
      m.pllf:=m.pllf + (m.plllag-m.pllf)*0.6;  (* 0.6 *)
 
      IF m.pllf>0.35 THEN m.pllf:=0.35 ELSIF m.pllf<-0.35 THEN m.pllf:=-0.35 END;     (* 0.35 *)
    END; 

    m.iffreqc:=m.iffreq + m.croase + VAL(INTEGER,m.pllf*PLLGAIN*m.ddsbase);
    m.state:=(m.state+1) MOD 4;
  END; 
END sampled4psk;

PROCEDURE realint(x:REAL; VAR g:REAL):INT16;  (* limit real input > +-1.0 to INT16*)
VAR r:REAL;
BEGIN
--  r:=SaveReal(CAST(CARDINAL, x))*g;
  r:=x*g;
  IF ABS(r)>=32766.0 THEN
    g:=32767.0*32766.0/ABS(r);
    r:=x*g;
    IF r>32767.0 THEN RETURN MAX(INT16) ELSIF r<-32767.0 THEN RETURN MIN(INT16) END;
  END;
  RETURN VAL(INT16, r)
END realint;

PROCEDURE inreform(VAR b:ARRAY OF INT16):CARDINAL;
VAR i, bs, rs, wp:CARDINAL;
    res:INTEGER;
    ib:RECORD CASE :CARDINAL OF
                0:c:ARRAY[0..MAXINBUF-1] OF Complex;
               |1:i:ARRAY[0..MAXINBUF*4-1] OF INT16;
               |2:b:ARRAY[0..MAXINBUF*8-1] OF CARD8;
              END;
       END;
    p:POINTER TO ARRAY[0..65535] OF BYTE;
    g:REAL;
BEGIN
  bs:=isize*(MAXINBUF*2);
  IF bs>(HIGH(b)+1)*2 THEN bs:=(HIGH(b)+1)*2 END;
  rs:=0;
  REPEAT
    p:=ADR(ib.b[rs]);
    res:=RdBin(iqfd, p^, bs-rs);
    IF res<=0 THEN RETURN 0 END;

    INC(rs, res);
  UNTIL rs>=bs;

  wp:=0;
  IF isize=1 THEN
    IF u8signed THEN
      FOR i:=0 TO rs-1 DO b[i]:=VAL(INT16, CAST(INT8, ib.b[i]))*256 END;
    ELSE
      FOR i:=0 TO rs-1 DO b[i]:=VAL(INT16, ib.b[i])*256-32640 END;
    END; 
    wp:=rs;
  ELSIF isize=2 THEN
--    FOR i:=0 TO rs DIV 2-1 DO b[i]:=ib.i[i] END;

    MOVE(ADR(ib), ADR(b), rs);
    wp:=rs DIV 2;
  ELSE
    g:=32767.0;
    FOR i:=0 TO rs DIV 8 - 1 DO
      b[wp]:=realint(ib.c[i].Re, g);
      INC(wp);
      b[wp]:=realint(ib.c[i].Im, g);
      INC(wp);
    END;
  END;
  RETURN wp
END inreform;


VAR wp, i:CARDINAL;
    ok:BOOLEAN;
    mq:pDQPSKMODEM;

BEGIN
  Parms;

  csdecoder.initsdec();

  IF mccfilename<>"" THEN readmccmnc END;
  RMinit;

  inlen:=0;
  rdp:=0;

  decodingtable[0]:=MAX(CARDINAL);
  MakeDDSi(DDS);
  iqfd:=OpenRead(iqfn);
  IF iqfd<0 THEN Error("open iq file") END;
  LOOP
    wp:=inreform(iqbuf);
    IF wp=0 THEN EXIT END;  
    
    mq:=dqpskmodems;
    WHILE mq<>NIL DO
      FOR i:=0 TO wp-2 BY 2 DO sampled4psk(iqbuf[i], iqbuf[i+1], mq^) END;
      mq:=mq^.next;
    END;

  END;

END tetrarx.