<*+M2EXTENSIONS *>
<*-COVERFLOW *>
<*-IOVERFLOW*>
<*-CHECKDIV *>
<*-CHECKRANGE *>
<*-GENFRAME*>
<*+NOPTRALIAS*>
<*-DOREORDER*>
<*-GENPTRINIT*>
<*CPU="PENTIUM"*>
<* IF __GEN_C__ THEN *>
  <*+COMMENT*>
  <*-GENDATE*>
  <*-GENCTYPES*>
  <*-CHECKNIL *>
  <*-CHECKINDEX*>
  <*-CHECKSET*>
  <*+GENCDIV*>
  <*+NOOPTIMIZE*>
  <*-GENSIZE*>
  <*-ASSERT*>
<* ELSE *>
  <*+CHECKNIL *>
  <*+CHECKINDEX*>
  <*+CHECKSET*>
<* END *>

(* (C)OE5DXL 1993-2015, GPL3 *)

(*
L1 interface registers, 32768 16bit registers:  (port 1..15)
address      calculation       usage
------------------------------------
1..0FH       [port]            bit  0..10 points to rx write position
                               bit 11..15 points to frame index of newest
                               complete rx frame
40H..3FFH    [port*64]         points to start of frames data
400H..3FFFH  [port*1024]       bit 0..7 rx frame data
                               bit 8..15 squelch value
4001H..400FH [port+4000H]      bit 0..10 points to tx read position
4400H..7FFFH [port*1024+4000H] bit 0..7 tx data
                               bit 8..10 tx baud
                               bit 13 stuff off
                               bit 14 loop off
                               bit 15 ptt
SetAddress sets adress
PutWord sets adress and high byte of data and postincrements adress modulo 1024
PutByte uses high byte and postincrements adress modulo 1024
GetWord sets adress and postincrements adress modulo 1024
GetByte postincrements adress modulo 1024
*)

IMPLEMENTATION MODULE frameio;

FROM SYSTEM IMPORT ADR, ADDRESS, FILL, CAST, CARD16, CARD8;
FROM l2 IMPORT adress, asize, dbuf, udp2buf, Parms, PORTS, SET16, pDATA, dupchk, l2verb;
FROM osi IMPORT SOCKET, udpsend, udpreceive, WrStrLn, WrStr, WrInt;
FROM aprsstr IMPORT IPNUM, UDPPORT, extrudp2, AppCRC;

CONST DCDRETRIES=500;

VAR size, from, udppos:CARDINAL;
    axv2:BOOLEAN;
    udpbuf:ARRAY[0..1600] OF CHAR;
    sock:SOCKET;
    PortL1:ARRAY[1..PORTS] OF RECORD
      lastBaud,                     (*insert flags if baud change*)
      oldi,                         (*last received frame index from hardware*)
      nextfrom,                     (*read next frame from hardware*)
      txakku:CARDINAL;              (*send next frame to hardware*)
      twoflags:BOOLEAN;
    END;


TYPE SET8=SET OF [0..7];
(*
VAR CRCL, CRCH:ARRAY[0..255] OF SET8;

PROCEDURE CRC(VAR frame:ARRAY OF CHAR; VAR crc:CARD16; size:CARDINAL);
VAR l,h:SET8;
    b:CARD8;
    i:INTEGER;
BEGIN
  l:=CAST(SET8, crc);
  h:=CAST(SET8, crc >> 8);
  FOR i:=0 TO VAL(INTEGER, size)-1 DO
    b:=CAST(CARD8, CAST(SET8, frame[i]) / l);
    l:=CRCL[b] / h;
    h:=CRCH[b];
  END;
  crc:=CAST(CARD16, l) + (CAST(CARD16, h) << 8);
END CRC;


PROCEDURE UDPCRC(frame-:ARRAY OF CHAR; size:INTEGER):CARDINAL;
VAR l,h:SET8;
    b:CARD8;
    i:INTEGER;
BEGIN
  l:=SET8{};
  h:=SET8{};
  FOR i:=0 TO size-1 DO
    b:=CAST(CARD8, CAST(SET8, frame[i]) / l);
    l:=CRCL[b] / h;
    h:=CRCH[b];
  END;
  RETURN ORD(CAST(CHAR, l))+256*ORD(CAST(CHAR, h))
END UDPCRC;
*)
(*
PROCEDURE opensock(num:CARDINAL; fromport, toport:UDPPORT):BOOLEAN;
BEGIN
  WITH udpsocks[num] DO
    fd:=openudp();
    IF (CAST(INTEGER,fd)<0) OR (bindudp(fd, fromport)<0) THEN RETURN FALSE END;
    dport:=toport;
  END;
  RETURN TRUE
END opensock;
*)


PROCEDURE rmnc;
VAR j,k:CARDINAL;
    cmd:BOOLEAN;
BEGIN
  adress[14]:=adress[7];
  asize:=15;
  k:=ORD(adress[0])*128+ORD(adress[1]) DIV 2;
  cmd:=ODD(k);
  k:=k DIV 2;
  j:=12;
  REPEAT
    adress[j]:=CHR((k MOD 10+48)*2);
    DEC(j);
    k:=k DIV 10;
  UNTIL j=6;
  IF cmd THEN adress[13]:=140C ELSE adress[13]:=340C END;
  j:=ORD(adress[2]);
  adress[0]:=CHR(j DIV 4*2+64);
  k:=ORD(adress[3]);
  adress[1]:=CHR((j MOD 4*16+k DIV 16+32)*2);
  j:=ORD(adress[4]);
  adress[2]:=CHR((k MOD 16*4+j DIV 64+32)*2);
  adress[3]:=CHR((j MOD 64+32)*2);
  j:=ORD(adress[5]);
  adress[4]:=CHR(j DIV 4*2+64);
  k:=ORD(adress[6]);
  adress[5]:=CHR((j MOD 4*16+k DIV 16+32)*2);
  adress[6]:=CHR((k MOD 16+48)*2+ORD(cmd)*128);
END rmnc;

PROCEDURE GetAField(port:CARDINAL):BOOLEAN;
VAR i,j, a:CARDINAL;
    c:CHAR; 
BEGIN
  IF size>=10 THEN
    IF size>=HIGH(adress) THEN a:=HIGH(adress) ELSE a:=size END;
    udppos:=0;
    FOR i:=0 TO a-1 DO
      c:=udpbuf[udppos]; INC(udppos);
      adress[i]:=c;
      IF ODD(ORD(c)) THEN (*address end mark*)

        IF i=1 THEN
          FOR j:=2 TO 6 DO adress[j]:=udpbuf[udppos]; INC(udppos) END;
          asize:=7;
        ELSE asize:=i+1 END;
--WrInt(asize, 4); WrStrLn("=as");

        IF (asize>=7) & (asize MOD 7 = 0) & (asize<=size) THEN
          adress[asize]:=udpbuf[udppos]; INC(udppos);  (*command*)
          INC(asize);
          DEC(size, asize);
--WrInt(size, 4); WrStrLn("=saf");
--FOR j:=0 TO asize-1 DO WrInt(ORD(adress[j]), 4); END; WrStrLn("=af");
          RETURN TRUE

        END;
        RETURN FALSE;

      END;
    END;
  END;
  RETURN FALSE
END GetAField;

PROCEDURE GetDField():BOOLEAN;
VAR i:INTEGER;
    crc:CARD16;
BEGIN
  IF size<=257 THEN
    WITH dbuf^ DO
      len:=size;
--WrInt(len, 4); WrStrLn("=ilen");

      FOR i:=0 TO INTEGER(size)-1 DO info[i]:=udpbuf[udppos]; INC(udppos) END;
(*
      crc:=0;
      CRC(adress,crc,asize);
      IF len<>0 THEN CRC(info,crc,len) END;
      crcok:=ORD(udpbuf[udppos]) + (ORD(udpbuf[udppos+1]) << 8) = crc;
*)
      crcok:=TRUE;
      IF asize=8 THEN rmnc END;
      RETURN TRUE;

    END;
  END;

  RETURN FALSE;
END GetDField;


PROCEDURE isdupe(crc1, crc2:CHAR; usock:CARDINAL):BOOLEAN;
VAR i,n,c:CARDINAL;
BEGIN
  WITH udpsocks[usock] DO
    c:=ORD(crc1)+ORD(crc2)*100H+10000H;
    n:=dupcnt;
    i:=dupchk;
    WHILE (i>0) & (dupcrcs[n]<>c) DO 
      DEC(i);
      IF n>0 THEN DEC(n) ELSE n:=HIGH(dupcrcs) END;
    END;
    IF i>0 THEN c:=0 END;                                (* dupe found do not store again *)  
    INC(dupcnt);
    IF dupcnt>HIGH(dupcrcs) THEN dupcnt:=0 END;
    dupcrcs[dupcnt]:=c;
  END;
  RETURN i>0      
END isdupe;

PROCEDURE getudp(usock:CARDINAL; VAR buf:ARRAY OF CHAR; VAR len:INTEGER);
VAR fromport     : UDPPORT;
    ipn          : IPNUM;
    crc1, crc2   : CHAR;
BEGIN
  len:=-1;
  IF CAST(INTEGER, udpsocks[usock].fd)<0 THEN RETURN END;

  len:=udpreceive(udpsocks[usock].fd, buf, SIZE(buf), fromport, ipn);
  IF (len>2) & (len<CAST(INTEGER, SIZE(buf)))
  & (NOT udpsocks[usock].checkip OR (udpsocks[usock].ipnum=ipn)) THEN

--WrInt(udpsend(usock^.fd, buf, len, usock^.dport, usock^.ip), 1);WrStrLn(" us");

    DEC(len, 2);
    crc1:=buf[len];
    crc2:=buf[len+1];
    IF (dupchk>0) & isdupe(crc1, crc2, usock) THEN
      IF l2verb THEN WrStrLn("axudp dupe deleted") END;
      len:=-1;
      RETURN;

    END;
    AppCRC(buf, len);
    IF (crc1<>buf[len]) OR (crc2<>buf[len+1]) THEN
      IF l2verb THEN WrStrLn(" axudp crc error") END;
      len:=-1;
      RETURN;

    END;
    IF buf[0]=1C THEN
      extrudp2(buf, udp2buf, len);
      IF udp2buf[1]<>"?" THEN
        udpsocks[usock].dcd:=CAST(SET8, udp2buf[1])*SET8{1}<>SET8{};
        udpsocks[usock].hastxdata:=CAST(SET8, udp2buf[1])*SET8{2}<>SET8{};
      END;
      IF len=0 THEN len:=-1 END;
      axv2:=TRUE; 
--WrStr("<");WrStr(udp2buf); WrStrLn(">");
    ELSE
      udp2buf[0]:=0C;
      udpsocks[usock].dcd:=FALSE;
      udpsocks[usock].hastxdata:=FALSE;
      axv2:=FALSE;
    END;
  ELSE len:=-1 END;
END getudp;


PROCEDURE GetFrame(port:CARDINAL):BOOLEAN;
VAR i:INTEGER;
    
BEGIN
  IF port=0 THEN RETURN FALSE END;

  getudp(port-1, udpbuf, i);
  IF i<0 THEN RETURN FALSE END;
 
--WrInt(i, 5); WrStrLn("=udpin");  
  size:=i;
  from:=0;

  IF GetAField(port) AND GetDField() THEN RETURN TRUE END;

  RETURN FALSE
END GetFrame;


PROCEDURE Modempoll(tport:CARDINAL);
VAR b:ARRAY[0..99] OF CHAR;
    ret:INTEGER; 
BEGIN
  IF (tport=0) OR (tport>HIGH(udpsocks)+1) THEN RETURN END;

  b[0]:=1C;
  b[1]:="?";
  b[2]:=0C;
  AppCRC(b, 3);
--WrStrLn("send ?");
  WITH udpsocks[tport-1] DO
    ret:=udpsend(fd, b, 5, toport, ipnum);
  END;
END Modempoll;


PROCEDURE DCD(port:CARDINAL):BOOLEAN;
BEGIN
  IF (port=0) OR (port-1>HIGH(udpsocks)) THEN RETURN FALSE END;

  WITH udpsocks[port-1] DO
    IF dcd THEN
      IF dcdretry>DCDRETRIES THEN
        Modempoll(port);
        dcdretry:=0;
      ELSE INC(dcdretry) END;
    ELSE dcdretry:=0 END;
--IF dcd THEN WrStrLn("dcd") END;
    RETURN dcd
  END;
END DCD;

PROCEDURE Sending(port:CARDINAL):BOOLEAN;
BEGIN
  IF (port=0) OR (port-1>HIGH(udpsocks)) THEN RETURN FALSE END;

  WITH udpsocks[port-1] DO
    IF hastxdata THEN
      IF txbufretry>DCDRETRIES THEN
        Modempoll(port);
        txbufretry:=0;
      ELSE INC(txbufretry) END;
--WrStr("txbufretry:");WrInt(txbufretry, 1);WrStrLn(""); 
    ELSE txbufretry:=0 END;
--IF hastxdata THEN WrStrLn("txing") END;
    RETURN hastxdata
  END;
END Sending;


PROCEDURE SendFrame(tport,Baud:CARDINAL;VAR Adress:ARRAY OF CHAR;
                    AdrLen:CARDINAL; dp:pDATA);
VAR i,j:CARDINAL;
    b:ARRAY[0..350] OF CHAR;
    ret:INTEGER;
BEGIN
  IF (tport=0) OR (tport>HIGH(udpsocks)+1) OR (AdrLen>=HIGH(b)) THEN RETURN END;
  DEC(tport);
  j:=0;
  FOR i:=0 TO AdrLen-1 DO b[j]:=Adress[i]; INC(j) END;
  IF dp<>NIL THEN
    FOR i:=0 TO dp^.len-1 DO b[j]:=dp^.info[i]; INC(j) END;
  END;
  AppCRC(b, j);
  WITH udpsocks[tport] DO
    ret:=udpsend(fd, b, j+2, toport, ipnum);
    hastxdata:=axv2;
  END;  
END SendFrame;


PROCEDURE Init;
VAR i,j:CARDINAL;
BEGIN
  axv2:=FALSE;
--  FILL(ADR(udpsocks), 0C, SIZE(udpsocks));
--  udpsocks[0].ip:=7F000001H;
--  IF NOT opensock(0, 5603, 5602) THEN WrStrLn("socket open error"); HALT END;
--  udpsocks[0].ip:=44<<24 + 143<<16 + 40<<8 + 90;
--  IF NOT opensock(0, 10094, 10094) THEN WrStrLn("socket open error"); HALT END;
--  udpsocks[0].ip:=192<<24 + 168<<16 + 1<<8 + 30;
--  IF NOT opensock(0, 11000, 11001) THEN WrStrLn("socket open error"); HALT END;
--  udpsocks[0].ip:=127<<24 + 0<<16 + 0<<8 + 1;
--  IF NOT opensock(0, 2603, 2602) THEN WrStrLn("socket open error"); HALT END;

END Init;

END frameio.