Topspeed_JPI/TS-V3/SRC/KERMIT.MOD

(* Release 3.10 *)
(*-------------------------------------------------------------------------*
*                                                                          *
*  KERMIT.MOD - COMMS Toolkit KERMIT file protocol                         *
*                                                                          *
*  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
*  All Rights Reserved                                                     *
*                                                                          *
*--------------------------------------------------------------------------*)

IMPLEMENTATION MODULE Kermit;
  IMPORT ComSetup,Filenames,FIO,FTSupport,Lib,RS232,SPRINTF,Str;

  CONST
    TooMany             = "Too many retries";
    UserAbort           = "User Abort";
    FileOpened          = "File Opened";
    FileClosed          = "File Closed";
    EndSession          = "Session Ends";
    XParams             = "Exchanging Params";
    OK                  = 0;
    SOH                 = 1;
    CHKLNTH             = 1;
    YES                 = ORD("Y");
    NO                  = ORD("N");
    MAXTRIES            = 5;
    MAXPACK             = 512;        (* My maximum extended-length packet size *)
    MAXWINDO            = 6;          (* My window size                         *)
    (* Kermit Packet Types *)
    DATA                = 100H+ORD('D');
    ACK                 = 100H+ORD('Y');
    NAK                 = 100H+ORD('N');
    SENDINIT            = 100H+ORD('S');
    ENDSESS             = 100H+ORD('B');
    FILEHDR             = 100H+ORD('F');
    EOFILE              = 100H+ORD('Z');
    ERROR               = 100H+ORD('E');
    QRSRVD              = 100H+ORD('Q');
    TIMEOUT             = 100H+ORD('T');
    ATTR                = 100H+ORD('A');
    (* flags = Bit Numbers for Capability mask *)
    XLPKTS              = 1;  (* True if extended length packets are supported *)
    WINDOWS             = 2;  (* True if sliding windows are supported         *)
    ATTPKTS             = 3;  (* True if attribute packets are supported       *)

  TYPE
    DefaultRec          = RECORD
                            MaxL       : CARDINAL; (* The max length packet to send        *)
                            Time       : CARDINAL; (* The timeout while waiting for a pkt  *)
                            NPad       : CARDINAL; (* The number of pad characters to send *)
                            PadC       : CARDINAL; (* The pad character to use             *)
                            Eoln       : CARDINAL; (* The end of line character to use     *)
                            QCtl       : CARDINAL; (* The char to use as Ctrl-Quote        *)
                            QBin       : CARDINAL; (* The char used for 8th bit quoting    *)
                            Chkt       : CARDINAL; (* The frame check type to use          *)
                            Rept       : CARDINAL; (* The char used for repeat encoding    *)
                            Capa       : BITSET;   (* Remote's capability mask             *)
                            WSiz       : CARDINAL; (* Window Size                          *)
                            XLen       : CARDINAL; (* Extended Packet Length               *)
                          END;
    Buffer              = ARRAY[0..MAXPACK-1] OF CHAR;
    TableEntry          = RECORD
                            PacketNo   : CARDINAL; (* seq no of this packet      *)
                            Acked      : BOOLEAN;  (* true if this entry is ok   *)
                            Sent       : CARDINAL; (* number of times this pkt sent *)
                            Data       : Buffer;   (* the actual packet contents *)
                            Lenth      : CARDINAL; (* Bytes of data in this pkt  *)
                            FilePos    : LONGCARD; (* the new file pointer       *)
                          END;

  VAR
    Tries               : CARDINAL;    (* Number of attempts to send/receive    *)
    SeqNo               : CARDINAL;    (* The sequence number I use/expect next *)
    WindowSize          : CARDINAL;    (* The current window size               *)
    SizeToSend          : CARDINAL;    (* Maximum size packet I can send        *)
    Default             : DefaultRec;  (* Settings for various protocol options *)
    f                   : FIO.File;    (* The file being sent/received          *)

(*...............................................*)

  PROCEDURE InitVars;
    BEGIN
      FTSupport.Errors:=0;
      FTSupport.LastMessage:='';
      FTSupport.XferMode := 'CHK';
      FTSupport.Transferred:=0;
      FTSupport.Aborted := FALSE;
      FTSupport.SizeInBytes:=0;
      WindowSize := MAXWINDO;
    END InitVars;

(*...............................................*)

  PROCEDURE Min(a,b:CARDINAL):CARDINAL;
    BEGIN
      IF a<b THEN
        RETURN(a);
      ELSE
        RETURN(b);
      END;
    END Min;

(*...............................................*)

  PROCEDURE Max(a,b:CARDINAL):CARDINAL;
    BEGIN
       IF a>b THEN
         RETURN(a);
       ELSE
         RETURN(b);
       END;
    END Max;

(*...............................................*)

  PROCEDURE ToChar(x:CARDINAL):CARDINAL;
    BEGIN
      RETURN x+20H;
    END ToChar;

(*...............................................*)

  PROCEDURE UnChar(x:CARDINAL):CARDINAL;
    BEGIN
      RETURN x-20H;
    END UnChar;

(*...............................................*)

  PROCEDURE Ctrl(x:CARDINAL):CARDINAL;
    BEGIN
      RETURN CARDINAL(BITSET(x) / BITSET(40H));
    END Ctrl;

(*...............................................*)

  PROCEDURE Receive(TLimit:CARDINAL):CARDINAL;
    VAR
      c                 : CHAR;
    BEGIN
      LOOP
        IF RS232.SerialRead(c,TLimit*10) THEN
          IF (ORD(c)=SOH) OR (c>=' ') THEN
            RETURN ORD(c);
          END;
        ELSE
          RETURN TIMEOUT;
        END;
      END;
    END Receive;

(*...............................................*)

  PROCEDURE Msg(s:ARRAY OF CHAR);
    VAR
      Lnth              : CARDINAL;
    BEGIN
      Lnth := Str.Length(s);
      Lib.Move(ADR(s),ADR(FTSupport.LastMessage),Lnth);
      FTSupport.LastMessage[Lnth] := 0C;
      FTSupport.UpdateStatus;
    END Msg;

(*...............................................*)

  PROCEDURE Error(s:ARRAY OF CHAR);
    BEGIN
      INC(FTSupport.Errors);
      Msg(s);
    END Error;

(*...............................................*)

  PROCEDURE SendPacket(tipe,SeqNo,DataLnth:CARDINAL);
    VAR
      i,p,CheckSum      : CARDINAL;
      Buff              : ARRAY[0..MAXPACK+15] OF CHAR;
      Extended          : BOOLEAN;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE sPutChar(c:CARDINAL);
      BEGIN
        Buff[p] := CHR(c);
        CheckSum := (CheckSum+c) MOD 100H;
        INC(p);
      END sPutChar;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    BEGIN (* SendPacket *)
      i:=0;
      p:=1;
      CheckSum:=0;
      WITH Default DO
        Extended := (XLPKTS IN Capa) AND (DataLnth>MaxL-(2+CHKLNTH));
      END;
      Buff[0]:=CHR(SOH);
      IF Extended THEN
        sPutChar(ToChar(0))
      ELSE
        sPutChar(ToChar(DataLnth+2+CHKLNTH))
      END;
      sPutChar(ToChar(SeqNo));
      sPutChar(tipe-100H);
      IF Extended THEN
        sPutChar(ToChar((DataLnth+CHKLNTH) DIV 95));
        sPutChar(ToChar((DataLnth+CHKLNTH) MOD 95));
        sPutChar(ToChar((CheckSum+(CheckSum>>6)) MOD 64));
      END;
      WHILE i<DataLnth DO sPutChar(ORD(FTSupport.FBuff[i]));
        INC(i)
      END;
      Buff[p] := CHR(ToChar((CheckSum+(CheckSum>>6)) MOD 64));
      Buff[p+1] := CHR(Default.Eoln);
      RS232.SerialWrite(Buff,p+2);
    END SendPacket;

(*...............................................*)

  (* Read a packet and return the packet type. *)
  PROCEDURE ReadPacket(VAR SeqNo,Lnth:CARDINAL; SkipSOH:BOOLEAN):CARDINAL;
    CONST
      BadChecksum       = "Bad Checksum";
    TYPE
      RdStates          = (Mark,Len,Seq,Type,LenX1,LenX2,HChk,Data,Check,Err);
    VAR
      Extended          : BOOLEAN;
      Timeout,rslt,
      PacketType,Cnt,
      HCheck,CheckSum   : CARDINAL;
      RdState           : RdStates;
    BEGIN
      RdState:=Mark;
      Timeout:=Default.Time;
      Timeout := Max(Timeout,10);
      LOOP
        IF SkipSOH THEN
          rslt:=SOH;
        ELSE
          rslt:=Receive(Timeout);
        END;
        IF rslt = TIMEOUT THEN
          Error("Timeout");
          RETURN TIMEOUT;
        ELSIF rslt = SOH THEN
          SkipSOH:=FALSE;
          RdState:=Len;
          CheckSum:=0;
          Cnt:=0;
          Extended:=FALSE;
        ELSE
          IF RdState # Check THEN
            CheckSum := CARDINAL(BITSET(CheckSum+rslt)*BITSET(0FFH));
          END;
          CASE RdState OF
            Mark        : (* do nothing, as SOH should have been trapped above *)|
            Len         : Lnth:=UnChar(rslt);
                          Extended:=(Lnth=0);
                          IF NOT Extended THEN
                            DEC(Lnth,2+CHKLNTH);
                          END;
                          RdState:=Seq;                                   |
            Seq         : SeqNo:=UnChar(rslt);
                          RdState:=Type;                                  |
            Type        : PacketType := 100H+rslt;
                          IF Extended THEN
                            RdState := LenX1
                          ELSIF Lnth>0 THEN
                            RdState:=Data
                          ELSE
                            RdState:=Check
                          END;                                            |
            LenX1       : Lnth:=UnChar(rslt);
                          RdState:=LenX2;                                 |
            LenX2       : Lnth := (Lnth*95+UnChar(rslt)) - CHKLNTH;
                          HCheck:=CheckSum;
                          RdState := HChk;                                |
            HChk        : IF rslt=ToChar((HCheck+(HCheck>>6)) MOD 64) THEN
                            IF Lnth>0 THEN
                              RdState:=Data;
                            ELSE
                              RdState:=Check;
                            END;
                         ELSE
                            Error(BadChecksum);
                            RETURN TIMEOUT;
                         END;                                             |
            Data        : FTSupport.FBuff[Cnt] := CHR(rslt);
                          INC(Cnt);
                          IF Cnt=Lnth THEN
                            RdState:=Check;
                          END;                                            |
            Check       : IF rslt=ToChar((CheckSum+(CheckSum>>6)) MOD 64) THEN
                            IF PacketType=ERROR THEN
                              Msg("Error Packet received");
                            END;
                            RETURN PacketType;
                          ELSE
                            Error(BadChecksum); RETURN TIMEOUT;
                          END;                                            |
            Err         : (* purge modem buffer *);
          END;
        END;
      END;
    END ReadPacket;

(*...............................................*)

  PROCEDURE NxtPktNo(SeqNo:CARDINAL):CARDINAL;
    BEGIN
      RETURN CARDINAL(BITSET(SeqNo+1) * BITSET(3FH));
    END NxtPktNo;

(*...............................................*)

  PROCEDURE SendInitParms(tipe:CARDINAL);
    VAR
      MyCapas           : BITSET;
    BEGIN
      (* This line says that I can use attribute and extended length packets *)
      MyCapas := {WINDOWS,XLPKTS,ATTPKTS};
      WITH Default DO
        WindowSize := Min(MAXWINDO,WSiz);
        FTSupport.FBuff[ 0] := CHR(ToChar(MaxL));
        FTSupport.FBuff[ 1] := CHR(ToChar(Time));
        FTSupport.FBuff[ 2] := CHR(ToChar(0));
        FTSupport.FBuff[ 3] := CHR(Ctrl(0));
        FTSupport.FBuff[ 4] := CHR(ToChar(Eoln));
        FTSupport.FBuff[ 5] := CHR(QCtl);
        FTSupport.FBuff[ 6] := 'Y';
        FTSupport.FBuff[ 7] := '1';
        FTSupport.FBuff[ 8] := CHR(Rept);
        FTSupport.FBuff[ 9] := CHR(ToChar(CARDINAL(MyCapas)));
        FTSupport.FBuff[10] := CHR(ToChar(WindowSize));     (* Window Size *)
        FTSupport.FBuff[11] := CHR(ToChar(MAXPACK DIV 95)); (* pkt lnth - High bits *)
        FTSupport.FBuff[12] := CHR(ToChar(MAXPACK MOD 95)); (* pkt lnth - Low bits *)
      END;
      SendPacket(tipe,SeqNo,13);
    END SendInitParms;

(*...............................................*)

  PROCEDURE GetInitParams():CARDINAL;
    TYPE
      InitStates        = (maxl,time,npad,padc,eol,qctl,qbin,chkt,rept,capas,capas2,windo,maxlx1,maxlx2,done);
    VAR
      rslt,p,c,Seq,Lnth : CARDINAL;
      temp              : BITSET;
      State             : InitStates;
    BEGIN
      IF Tries=MAXTRIES THEN
        Error(TooMany);
        RETURN(ERROR);
      END;
      INC(Tries);
      rslt := ReadPacket(Seq,Lnth,FALSE);
      IF (rslt # SENDINIT) AND (rslt # ACK) THEN
        RETURN(rslt);
      END;
      (* Set defaults *)
      WITH Default DO
        Capa:={};
        p:=0;
        State:=maxl;
        LOOP
          IF p<Lnth THEN
            c:=ORD(FTSupport.FBuff[p]);
            INC(p)
          ELSE
            c:=0;
          END;
          CASE State OF
            maxl        : MaxL:=UnChar(c);
                          State:=time;                                    |
            time        : Time:=UnChar(c);
                          State:=npad;                                    |
            npad        : NPad:=UnChar(c);
                          IF NPad=0 THEN
                            INC(p);
                            State:=eol;
                          ELSE
                            State:=padc;
                          END;                                            |
            padc        : PadC:=Ctrl(c);
                          State:=eol;                                     |
            eol         : Eoln:=UnChar(c);
                          State:=qctl;                                    |
            qctl        : QCtl:=c;
                          State:=qbin;                                    |
             (* optional features *)
            qbin        : IF (c=YES) OR (c=NO) THEN
                            QBin:=0;
                          ELSE
                            QBin:=c;
                          END;
                          State:=chkt;                                    |
            chkt        : (* Ignore frame check type for the moment *)
                          State := rept;                                  |
            rept        : IF c=32 THEN
                            Rept:=0;
                          ELSE
                            Rept:=c;
                          END;
                          State:=capas;                                   |
            capas       : IF c<32 THEN
                            Capa:={};
                          ELSE
                            Capa:=BITSET(UnChar(c));
                          END;
                          IF 0 IN Capa THEN
                            State:=capas2;
                          ELSE
                            State:=windo;
                          END;                                            |
            capas2      : IF c<32 THEN
                            temp:={};
                          ELSE
                            temp:=BITSET(UnChar(c));
                          END;
                          IF NOT (0 IN Capa) THEN
                            State:=windo;
                          END;                                            |
            windo       : IF c<32 THEN
                            WSiz:=0;
                          ELSE
                            WSiz:=UnChar(c);
                          END;
                          State:=maxlx1;                                  |
            maxlx1      : IF c<32 THEN
                            XLen:=0;
                          ELSE
                            XLen:=UnChar(c);
                          END;
                          State:=maxlx2;                                  |
            maxlx2      : IF c>31 THEN
                            XLen := XLen+(UnChar(c)<<6);
                          END;
                          State:=done;                                    |
            done        : EXIT;                                           |
          END;
        END;
      END;
      RETURN rslt;
    END GetInitParams;

(*...............................................*)

  PROCEDURE WriteData(Lnth:CARDINAL;VAR FBuff,Buff:ARRAY OF CHAR;WriteIt:BOOLEAN):CARDINAL;
    (* Get data from an incoming packet into a file. *)
    VAR
      i,rep,c,BuffPtr   : CARDINAL;
      SetBit8           : BOOLEAN;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE wPutChar(c:CARDINAL);
      BEGIN
        IF WriteIt AND (BuffPtr=MAXPACK) THEN
          INC(FTSupport.Transferred,MAXPACK);
          FIO.WrBin(f,Buff,MAXPACK);
          BuffPtr := 0;
        END;
        Buff[BuffPtr] := CHR(c);
        INC(BuffPtr);
      END wPutChar;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE Low(In:CARDINAL):CARDINAL;
      BEGIN
        RETURN CARDINAL(BITSET(In) - BITSET{7});
      END Low;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    BEGIN (* WriteData *)
      BuffPtr:=0;
      i:=0;
      WITH Default DO
        WHILE i<Lnth DO
          rep := 1;
          c:=ORD(FBuff[i]);
          INC(i);     (* Get character *)
          IF c=Rept THEN
            rep := UnChar(ORD(FBuff[i]));
            c := ORD(FBuff[i+1]);
            INC(i,2);
          END;
          SetBit8:=FALSE;
          IF c=QBin THEN
            SetBit8 := TRUE;
            c:=ORD(FBuff[i]);
            INC(i);
          END;
          IF c=QCtl THEN                (* Control quote? *)
            c:=ORD(FBuff[i]);
            INC(i); (* Get the quoted character *)
            IF (Low(c) # QCtl) & (Low(c) # QBin) & (Low(c) # Rept) THEN
              c:=Ctrl(c);
            END;
          END;
          IF SetBit8 THEN
            c := CARDINAL(BITSET(c)+{7});
          END;
          WHILE rep>0 DO
            wPutChar(c);
            DEC(rep);     (* Put the char in the file *)
          END;
        END;
      END;
      IF (WriteIt) AND (BuffPtr>0) THEN
        FIO.WrBin(f,Buff,BuffPtr);
        INC(FTSupport.Transferred,LONGCARD(BuffPtr));
      END;
      IF WriteIt THEN
        FTSupport.UpdateStatus
      END;
      RETURN BuffPtr;
    END WriteData;

(*...............................................*)

  PROCEDURE GetFileHeader():CARDINAL;
    VAR
      rslt,Seq,Lnth     : CARDINAL;
    BEGIN
      LOOP
        IF Tries=MAXTRIES THEN
          Error(TooMany);
          RETURN(ERROR);
        END;
        INC(Tries);
        rslt := ReadPacket(Seq,Lnth,FALSE);
        CASE rslt OF
          FILEHDR       : Lnth := WriteData(Lnth,FTSupport.FBuff,FTSupport.FileSpec,FALSE);
                          FTSupport.FileSpec[Lnth] := 0C;
                          FTSupport.CompleteFilename;
                          FTSupport.NewFilename;
                          f := FIO.Create(FTSupport.FileSpec);
                          IF FIO.IOresult() # 0 THEN
                            Error("File Create Error"); RETURN ERROR
                          END;
                          Msg(FileOpened); RETURN rslt;                   |
          TIMEOUT       : SendPacket(NAK,NxtPktNo(SeqNo),0);              |
          ERROR,
          SENDINIT,
          EOFILE,
          ENDSESS       : RETURN rslt;                                    |
        ELSE
          RETURN ERROR;
        END;
      END;
    END GetFileHeader;

(*...............................................*)

  PROCEDURE GetFileAttributes(Lnth:CARDINAL);
    VAR
      attr              : CHAR;
      p,rslt,len        : CARDINAL;
    BEGIN
      (* Run along attribute data looking for "Size in Bytes" attribute. *)
      (* This is the only attribute we can actually use.                 *)
      p:=0;
      WHILE p<Lnth DO
        attr:=FTSupport.FBuff[p];
        INC(p);
        len:=UnChar(ORD(FTSupport.FBuff[p]));
        INC(p);
        IF attr='1' THEN (* found Size in bytes *)
          FTSupport.SizeInBytes := 0;
          WHILE len>0 DO
            FTSupport.SizeInBytes := FTSupport.SizeInBytes*10+LONGCARD(ORD(FTSupport.FBuff[p])-48);
            INC(p);
            DEC(len);
          END;
          FTSupport.UpdateStatus;
        ELSE
          INC(p,len);
        END;
      END;
    END GetFileAttributes;

(*...............................................*)

  PROCEDURE GetFileData():CARDINAL;
    VAR
      i,p,rslt,Seq,Lnth,
      first,last        : CARDINAL;
      RcvTable          : ARRAY[0..MAXWINDO-1] OF TableEntry;
      WriteBuff         : Buffer;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE NAKit(Seq:CARDINAL);
      BEGIN
        SendPacket(NAK,Seq,0);
      END NAKit;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE InitReceiveTable(FirstSeqNo:CARDINAL);
      VAR
        i               : CARDINAL;
      BEGIN
        first:=0;
        last:=WindowSize-1;
        FOR i:=0 TO WindowSize-1 DO
          WITH RcvTable[i] DO
            PacketNo := CARDINAL(BITSET(FirstSeqNo+i+1)*BITSET(3FH));
            Acked := FALSE;
            Lenth := 0;
          END;
        END;
      END InitReceiveTable;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE Duplicate(Seq:CARDINAL; VAR Index:CARDINAL):BOOLEAN;
      VAR
        i               : CARDINAL;
      BEGIN
        FOR i:=0 TO WindowSize-1 DO
          IF Seq=RcvTable[i].PacketNo THEN
            Index:=i;
            RETURN(TRUE)
          END;
        END;
        RETURN FALSE;
      END Duplicate;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE MostWanted():CARDINAL;
      VAR
        i,p             : CARDINAL;
      BEGIN
        p:=first;
        FOR i:=0 TO WindowSize-1 DO
          IF NOT RcvTable[p].Acked THEN
            RETURN(p);
          END;
          p := (p+1) MOD WindowSize;
        END;
        RETURN NxtPktNo(RcvTable[last].PacketNo);
      END MostWanted;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE RotateTable():CARDINAL;
      VAR
        i,NextPkt        :CARDINAL;
      BEGIN
        NextPkt := NxtPktNo(RcvTable[last].PacketNo);
        (* Ok, now rotate the window. Not physically, just adjust the    *)
        (* first and last pointers.                                      *)
        last:=first;
        first:=(first+1) MOD WindowSize;
        WITH RcvTable[last] DO (* write old contents then clear entry *)
          IF NOT Acked THEN
            RETURN(ERROR);
          END;
          IF Lenth>0 THEN
            i:=WriteData(Lenth,Data,WriteBuff,TRUE);
          END;
          Acked:=FALSE;
          PacketNo:=NextPkt;
          Lenth:=0;
        END;
        RETURN OK;
      END RotateTable;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE StoreData(Index,Lnth:CARDINAL);
      BEGIN
        WITH RcvTable[Index] DO
          IF Acked THEN
            Msg("Duplicate Packet");
          END;
          Acked:=TRUE;
          Lenth:=Lnth;
          Lib.Move(ADR(FTSupport.FBuff),ADR(Data),Lenth);
        END;
      END StoreData;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    BEGIN (* GetFileData *)
      InitReceiveTable(SeqNo); (* initialise receive table *)
      LOOP
        IF FTSupport.AbortRequested() THEN
          Msg(UserAbort);
          RETURN ERROR;
        END;
        IF Tries=MAXTRIES THEN
          Msg(TooMany);
          RETURN(ERROR);
        END;
        INC(Tries);
        rslt := ReadPacket(Seq,Lnth,FALSE);
        CASE rslt OF
          DATA          : Tries := 0;
                          IF Duplicate(Seq,i) THEN
                            SendPacket(ACK,Seq,0);
                            StoreData(i,Lnth);
                          ELSE (* new packet *)
                            i:=0;
                            SendPacket(ACK,Seq,0);
                            REPEAT
                              INC(i);
                              IF RotateTable()=ERROR THEN
                                Error("Out of Sequence!");
                                RETURN ERROR;
                              END;
                            UNTIL Seq=RcvTable[last].PacketNo;
                            StoreData(last,Lnth);
                            IF i>1 THEN (* NAK any packets skipped *)
                              p:=first;
                              FOR i:=0 TO WindowSize-1 DO
                                WITH RcvTable[p] DO
                                  IF NOT Acked THEN
                                    Error("NAK: Packets Skipped");
                                    NAKit(PacketNo);
                                  END;
                                END;
                                p := (p+1) MOD WindowSize;
                              END;
                            END;
                          END;                                            |
          ATTR          : Tries := 0;
                          SendPacket(ACK,Seq,0);
                          GetFileAttributes(Lnth);
                          InitReceiveTable(Seq);                          |
          TIMEOUT       : Error("NAK: Timeout");
                          NAKit(MostWanted());                            |
          ERROR         : RETURN rslt;                                    |
          FILEHDR       : RETURN rslt;                                    |
          EOFILE        : p:=first;
                          FOR i:=0 TO WindowSize-1 DO
                            WITH RcvTable[p] DO
                              IF Acked AND (Lenth>0) THEN
                                Lnth := WriteData(Lenth,Data,WriteBuff,TRUE);
                              END;
                            END;
                            p := (p+1) MOD WindowSize;
                          END;
                          RETURN EOFILE;                                  |
        ELSE
          RETURN ERROR;
        END;
        SeqNo := Seq;
      END;
    END GetFileData;

(*...............................................*)

  PROCEDURE RxStateMachine():CARDINAL;
    TYPE
      RxStates          = (rSendInit,rFHeader,rFData);
    VAR
      rslt              : CARDINAL;
      RxState           : RxStates;
    BEGIN
      RxState := rSendInit;
      SeqNo := 0;         (* Start Sequence Number *)
      Default.Time := 15; (* default timeout for Send-Init packet *)
      Default.Eoln := 13;
      Tries := 0;
      LOOP
        CASE RxState OF
          rSendInit     : rslt := GetInitParams();
                          IF rslt=ERROR THEN
                            RETURN ERROR
                          ELSIF rslt=SENDINIT THEN
                            SendInitParms(ACK);
                            Tries := 0;
                            RxState:=rFHeader;
                          ELSE (* timeout *)
                            SendPacket(NAK,SeqNo,0);
                          END;                                            |
          rFHeader      : InitVars;
                          rslt := GetFileHeader();
                          IF rslt=ERROR THEN
                            RETURN ERROR
                          ELSIF rslt=SENDINIT THEN
                            SendInitParms(ACK);
                          ELSIF rslt=EOFILE THEN
                            SendPacket(ACK,SeqNo,0);
                          ELSIF rslt=ENDSESS THEN
                            SeqNo := NxtPktNo(SeqNo);
                            SendPacket(ACK,SeqNo,0);
                            Msg(EndSession);
                            RETURN OK;
                          ELSIF rslt=FILEHDR THEN
                            SeqNo := NxtPktNo(SeqNo);
                            SendPacket(ACK,SeqNo,0);
                            Tries := 0;
                            RxState := rFData;
                          END;                                            |
          rFData        : rslt := GetFileData();
                          IF rslt=ERROR THEN
                            RETURN ERROR
                          ELSIF rslt=FILEHDR THEN
                            SendPacket(ACK,SeqNo,0);
                          ELSIF rslt=EOFILE THEN
                            SeqNo := NxtPktNo(SeqNo);
                            SendPacket(ACK,SeqNo,0);
                            Msg(FileClosed);
                            FIO.Close(f);
                            Tries := 0;
                            RxState := rFHeader;
                          END;                                            |
        END;
      END;
    END RxStateMachine;

(*...............................................*)

  PROCEDURE KermitReceive():CARDINAL;
    VAR
      rslt:CARDINAL;
    BEGIN
      InitVars;
      FTSupport.OpenStatusWindow('SuperKermit Download');
      rslt := RxStateMachine();
      IF rslt=ERROR THEN
        SendPacket(ERROR,SeqNo,0);
      END;
      FIO.Close(f);
      FTSupport.CloseStatusWindow;
      RETURN rslt;
    END KermitReceive;

(*...............................................*)

  PROCEDURE GetPath(Wild:ARRAY OF CHAR; VAR Path:ARRAY OF CHAR):BOOLEAN;
    VAR
      Drive,Ext         : ARRAY[0..4] OF CHAR;
      Name              : ARRAY[0..12] OF CHAR;
    BEGIN
      IF NOT Filenames.ParseFilename(Wild,Drive,Path,Name,Ext) THEN
        RETURN(FALSE);
      END;
      Name := '';
      Ext:='';
      Filenames.MakeFilename(Drive,Path,Name,Ext,Path);
      RETURN TRUE;
    END GetPath;

(*...............................................*)

  PROCEDURE SendMyParams():CARDINAL;
    VAR
      rslt              : CARDINAL;
    BEGIN
      Msg(XParams);
      WITH Default DO
        WITH ComSetup.Setup.Kermit DO
          MaxL:=90;
          Time:=15;
          NPad:=NumPadChars;
          PadC:=ORD(PadChar);
          Eoln:=ORD(EolChar);
          QCtl:=ORD(CtlQuote);
          QBin:=ORD(EightBitQuote);
          Chkt:=1;
          Rept:=ORD(ReptPrefix);
          Capa:={WINDOWS,XLPKTS,ATTPKTS};
          WSiz:=MAXWINDO;
          XLen:=MAXPACK;
        END;
      END;
      Tries:=0;
      LOOP
        SendInitParms(SENDINIT);
        rslt := GetInitParams();
        CASE rslt OF
          ACK           : (* this is what I want*)
                          WITH Default DO
                            IF WINDOWS IN Capa THEN
                              WindowSize := Max(1,Min(WSiz,MAXWINDO));
                            ELSE
                              WindowSize := 1;
                            END;
                            IF (QBin=YES) OR (QBin=NO) THEN
                              QBin:=0;
                            END;
                            IF XLPKTS IN Capa THEN
                              SizeToSend := Min(MAXPACK,XLen-CHKLNTH)
                            ELSE
                              SizeToSend := MaxL-(CHKLNTH+2)
                            END;
                          END;
                          SeqNo := NxtPktNo(SeqNo);
                          RS232.FlushInBuf;
                          RETURN ACK;                                     |
          TIMEOUT       : (* loop again *)                                |
        ELSE
          RETURN ERROR;
        END;
      END;
    END SendMyParams;

(*...............................................*)

  PROCEDURE SendMessage(tipe,DataLnth:CARDINAL):CARDINAL;
    VAR
      rslt,Seq,Lnth     : CARDINAL;
    BEGIN
      Tries := 0;
      LOOP
        SendPacket(tipe,SeqNo,DataLnth);
        rslt := ReadPacket(Seq,Lnth,FALSE);
        IF (rslt=ERROR) OR (rslt=ACK) THEN
          SeqNo := NxtPktNo(SeqNo);
          RETURN(rslt);
        END;
      END;
    END SendMessage;

(*...............................................*)

  PROCEDURE SendFileHeader(VAR Path:ARRAY OF CHAR):CARDINAL;
    (* send file header and lnth attribute *)
    VAR
      rslt,Lnth         : CARDINAL;
    BEGIN
      Lnth:=Str.Length(FTSupport.FileSpec);
      Str.Copy(FTSupport.FBuff,FTSupport.FileSpec);
      rslt := SendMessage(FILEHDR,Lnth);
      IF rslt # ACK THEN
        RETURN(rslt);
      END;
      IF Path[0] # 0C THEN
        Str.Concat(FTSupport.FileSpec,Path,FTSupport.FileSpec);
      END;
      f := FIO.Open(FTSupport.FileSpec);
      IF FIO.IOresult() # 0 THEN
        RETURN(ERROR);
      END;
      IF NOT (ATTPKTS IN Default.Capa) THEN
        RETURN(ACK);
      END;
      FTSupport.SizeInBytes := FIO.Size(f);
      SPRINTF.SPrintF1("1$%u",FTSupport.SizeInBytes,FTSupport.FBuff);
      Lnth := Str.Length(FTSupport.FBuff);
      FTSupport.FBuff[1] := CHR(ToChar(Lnth-2));
      FTSupport.NewFilename;
      Msg(FileOpened);
      RETURN SendMessage(ATTR,Lnth);
    END SendFileHeader;

(*...............................................*)

  PROCEDURE SendFileData():CARDINAL;
    TYPE
      SetOfChar         = SET OF CHAR;
    VAR
      rslt,rptr,
      bytesread,
      NextToSend,first,
      last,pbstack      : CARDINAL;
      Stack             : ARRAY[0..1] OF CARDINAL;
      CtrlChars         : SetOfChar;
      RxPos             : LONGCARD;
      SndTable          : ARRAY[0..MAXWINDO-1] OF TableEntry;
      ReadBuff          : Buffer;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE PushBack(c:CARDINAL);
      BEGIN
        Stack[pbstack]:=c;
        INC(pbstack);
      END PushBack;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE GetChar(VAR c:CARDINAL):CARDINAL;
      BEGIN
        IF pbstack>0 THEN
          DEC(pbstack);
          c:=Stack[pbstack];
        ELSE
          WHILE rptr=bytesread DO
            IF bytesread<MAXPACK THEN
              c:=0FFFFH;
              RETURN(c);
            END;
            bytesread := FIO.RdBin(f,ReadBuff,MAXPACK);
            INC(RxPos,LONGCARD(bytesread));
            rptr := 0;
          END;
          c := ORD(ReadBuff[rptr]);
          INC(rptr);
        END;
        RETURN c;
      END GetChar;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE FillBuffer(Index:CARDINAL);
      VAR
        wptr,c,c2,nextc,
        rep,SafetyMargin: CARDINAL;
      BEGIN
        WITH SndTable[Index] DO
          wptr:=0;
          SafetyMargin:=SizeToSend-5;
          IF Default.QBin=0 THEN
            INC(SafetyMargin);
          END;
          WHILE (wptr<=SafetyMargin) AND (GetChar(c) # 0FFFFH) DO
            rep:=1;
            IF Default.Rept>0 THEN (* are we allowed repeated chars? *)
              (* count repeated chars *)
              WHILE (rep<94) AND (GetChar(nextc)=c) DO
                INC(rep);
              END;
              IF rep<94 THEN
                PushBack(nextc);
              END;
              IF rep>1 THEN
                IF rep=2 THEN (* not worth compressing *)
                  PushBack(c);
                ELSE
                  Data[wptr]:=CHR(Default.Rept);
                  INC(wptr);
                  Data[wptr]:=CHR(ToChar(rep));
                  INC(wptr);
                END;
              END;
            END;
            c2 := CARDINAL(BITSET(c)*BITSET(127));
            IF (Default.QBin>0) AND (c>127) THEN
              c:=c2;
              Data[wptr]:=CHR(Default.QBin);
              INC(wptr);
            END;
            IF CHR(c) IN CtrlChars THEN
              Data[wptr]:=CHR(Default.QCtl);
              INC(wptr);
              IF (c2<32) OR (c2=127) THEN
                c:=Ctrl(c);
              END;
            END;
            Data[wptr]:=CHR(c);
            INC(wptr);
          END;
          Lenth := wptr;
          FilePos := RxPos;
        END;
      END FillBuffer;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE InitSndTable;
      VAR
        i               : CARDINAL;
      BEGIN
        CtrlChars := SetOfChar{0C..CHR(31),CHR(127),CHR(128)..CHR(159),CHR(255)};
        INCL(CtrlChars,CHR(Default.Rept));
        INCL(CtrlChars,CHR(Default.QBin));
        INCL(CtrlChars,CHR(Default.QCtl));
        pbstack:=0;
        rptr:=0FFFFH;
        bytesread:=rptr;
        first:=0;
        last:=WindowSize-1;
        RxPos := 0;
        FOR i:=0 TO WindowSize-1 DO
          WITH SndTable[i] DO
            PacketNo:=(SeqNo+i) MOD 64;
            Acked:=FALSE;
            Sent := 0;
          END;
          FillBuffer(i);
        END;
      END InitSndTable;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE SendIt(Index:CARDINAL):CARDINAL;
      BEGIN
        WITH SndTable[Index] DO
          IF Lenth=0 THEN
            RETURN(OK);
          END;
          IF Sent=MAXTRIES THEN
            RETURN(ERROR);
          END;
          INC(Sent);
          Lib.Move(ADR(Data),ADR(FTSupport.FBuff),Lenth);
          SendPacket(DATA,PacketNo,Lenth);
        END;
        RETURN OK;
      END SendIt;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE WindowClosed():BOOLEAN;
      (* Try and find the next packet to send by searching for the next  *)
      (* packet which has not yet been sent and which has length>0. If   *)
      (* one is found then the window has not yet closed, otherwise it   *)
      (* is closed.                                                      *)
      VAR
        i,p             : CARDINAL;
      BEGIN
        p:=NextToSend;
        FOR i:=0 TO WindowSize-1 DO
          WITH SndTable[p] DO
            IF (Sent=0) AND (Lenth>0) THEN
              NextToSend:=p;
              RETURN(FALSE);
            END;
          END;
          p := (p+1) MOD WindowSize;
        END;
        RETURN TRUE;
      END WindowClosed;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE Done():BOOLEAN;
      VAR
        i               : CARDINAL;
      BEGIN
        FOR i:=0 TO WindowSize-1 DO
          IF SndTable[i].Lenth>0 THEN
            RETURN(FALSE);
          END;
        END;
        RETURN TRUE;
      END Done;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE TestReply():CARDINAL;
      VAR
        next,rslt,Seq,
        Lnth,i,ptr      : CARDINAL;
        GotSOH          : BOOLEAN;
        c               : CHAR;
      BEGIN
        LOOP
          IF FTSupport.AbortRequested() THEN
            Msg(UserAbort);
            RETURN(ERROR);
          END;
          IF Done() THEN
            RETURN(OK);
          END;
          Tries:=0;
          GotSOH:=FALSE;
          IF WindowClosed() THEN
            (* force a wait for a reply *)
            rslt := ReadPacket(Seq,Lnth,FALSE);
          ELSE
            (* Flush input buffer, looking out for a reply *)
            IF RS232.SerialRead(c,0) THEN
              REPEAT
              UNTIL (ORD(c)=SOH) OR (NOT RS232.SerialRead(c,0));
              GotSOH := (ORD(c)=SOH);
            END;
            IF GotSOH THEN
              rslt := ReadPacket(Seq,Lnth,TRUE);
            ELSE
              RETURN OK;
            END
          END;
          CASE rslt OF
            ACK         : ptr:=first;
                          FOR i:=0 TO WindowSize-1 DO
                            WITH SndTable[ptr] DO
                              IF PacketNo=Seq THEN
                                Acked:=TRUE;
                              END;
                            END;
                            ptr := (ptr+1) MOD WindowSize;
                          END;
                          (* Rotate the table *)
                          WHILE SndTable[first].Acked DO
                            FTSupport.Transferred := SndTable[first].FilePos;
                            FTSupport.UpdateStatus;
                            next := NxtPktNo(SndTable[last].PacketNo);
                            last:=first;
                            first:=(first+1) MOD WindowSize;
                            WITH SndTable[last] DO
                              PacketNo:=next;
                              Acked:=FALSE;
                              Sent:=0;
                            END;
                            FillBuffer(last);
                          END;
                          IF WindowSize=1 THEN
                            RETURN(OK);
                          END;                                            |
            NAK         : ptr:=first;
                          FOR i:=0 TO WindowSize-1 DO
                            WITH SndTable[ptr] DO
                              IF PacketNo=Seq THEN
                                IF SendIt(ptr)=ERROR THEN
                                  RETURN(ERROR);
                                END;
                              END;
                            END;
                            ptr := (ptr+1) MOD WindowSize;
                          END;                                            |
            TIMEOUT     : (* resend the oldest UnAcked packet *)
                          IF SendIt(first)=ERROR THEN
                            RETURN(ERROR);
                          END;                                            |
          ELSE
            RETURN ERROR;
          END;
        END;
      END TestReply;

(*. . . . . . . . . . . . . . . . . . . . . . . .*)

    BEGIN (* SendFileData *)
      InitSndTable;
      NextToSend:=0;
      rslt:=OK;
      LOOP
        IF Done() THEN
          EXIT;
        END;
        rslt := SendIt(NextToSend);
        IF rslt=ERROR THEN
          EXIT;
        END;
        NextToSend := (NextToSend+1) MOD WindowSize;
        rslt := TestReply();
        IF rslt=ERROR THEN
          EXIT;
        END;
      END;
      SeqNo := SndTable[first].PacketNo;
      IF rslt # ERROR THEN
        rslt:=OK;
      END;
      RETURN rslt;
    END SendFileData;

(*...............................................*)

  PROCEDURE TxStateMachine(VAR Wild:ARRAY OF CHAR):CARDINAL;
    TYPE
      TxStates          = (TxInit,TxSendInit,TxSendHdr,TxSendData,TxSendEOF,TxEndSess);
    VAR
      State             : TxStates;
      GotFile           : BOOLEAN;
      rslt              : CARDINAL;
      Path              : ARRAY[0..80] OF CHAR;
      Dir               : FIO.DirEntry;
    BEGIN
      State := TxInit;
      SeqNo := 0;
      LOOP
        IF FTSupport.AbortRequested() THEN RETURN(ERROR) END;
        CASE State OF
          TxInit        : IF NOT GetPath(Wild,Path) THEN
                            RETURN(ERROR);
                          END;
                          GotFile := FIO.ReadFirstEntry(Wild,FIO.FileAttr{},Dir);
                          IF NOT GotFile THEN
                            Error("No Matching Files");
                            RETURN ERROR;
                          END;
                          Str.Copy(FTSupport.FileSpec,Dir.Name);
                          State:=TxSendInit;                              |
          TxSendInit    : IF SendMyParams() # ACK THEN
                            RETURN(ERROR);
                          END;
                          State:=TxSendHdr;                               |
          TxSendHdr     : FTSupport.Transferred:=0;
                          IF SendFileHeader(Path) # ACK THEN
                            RETURN(ERROR);
                          END;
                          State := TxSendData;                            |
          TxSendData    : IF SendFileData()=ERROR THEN
                            RETURN(ERROR);
                          END;
                          State := TxSendEOF;                             |
          TxSendEOF     : IF SendMessage(EOFILE,0) # ACK THEN
                            RETURN(ERROR);
                          END;
                          FIO.Close(f);
                          Msg(FileClosed);
                          GotFile := FIO.ReadNextEntry(Dir);
                          IF GotFile THEN
                            State:=TxSendHdr;
                          ELSE
                            State:=TxEndSess;
                          END;
                          Str.Copy(FTSupport.FileSpec,Dir.Name);          |
          TxEndSess     : IF SendMessage(ENDSESS,0) # ACK THEN
                            RETURN(ERROR);
                          END;
                          Msg(EndSession);
                          RETURN OK;                                      |
        END;
      END;
    END TxStateMachine;

(*...............................................*)

  PROCEDURE KermitSend(wild:ARRAY OF CHAR):CARDINAL;
    VAR
      rslt              : CARDINAL;
    BEGIN
      InitVars;
      FTSupport.OpenStatusWindow('SuperKermit Upload');
      rslt := TxStateMachine(wild);
      IF rslt=ERROR THEN
        SendPacket(ERROR,SeqNo,0);
      END;
      FIO.Close(f);
      FTSupport.CloseStatusWindow;
      RETURN rslt;
    END KermitSend;

(*...............................................*)

END Kermit.