Topspeed_JPI/TS-V3/SRC/XMODEM.MOD

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

IMPLEMENTATION MODULE XModem;
  IMPORT Lib,FTSupport,CommUtil,FIO,Str,RS232;
  FROM FTSupport        IMPORT ACK,CAN,CRCREQ,EOT,NAK,SOH,STX;

  VAR
    f                   : FIO.File;
    Response            : CHAR;
    CRCCheck,
    ResponseWaiting     : BOOLEAN;
    LastBlockNo,BlockNo,
    BlockSize           : CARDINAL;

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

  PROCEDURE InitVars(VAR Filename:ARRAY OF CHAR);
    BEGIN
      FTSupport.Errors:=0;
      FTSupport.LastMessage:='';
      FTSupport.XferMode := 'CRC';
      FTSupport.Transferred:=0;
      FTSupport.Aborted := FALSE;
      FTSupport.SizeInBytes:=0;
      Str.Copy(FTSupport.FileSpec,Filename);
      BlockNo:=1;
      LastBlockNo:=0FFFFH;
      BlockSize:=128;
      CRCCheck:=TRUE;
    END InitVars;

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

  PROCEDURE ReceiveData():CARDINAL;
    VAR
      c                 : CHAR;
      RxBlk,CRC,RxCRC,
      CheckSum,Result,
      Cnt,CRCIndex      : CARDINAL;
      RxState           : (Blk,Compl,Data,Chk,CRCH,CRCL,Flushing);
    BEGIN
      (* Already had the first character SOH or STX *)
      RxState:=Blk;
      CRC:=0;
      CheckSum:=0;
      Cnt:=0;
      Result:=0;
      LOOP
        IF FTSupport.Aborted THEN
          RETURN(128+6);
        END;
        IF NOT RS232.SerialRead(c,50) THEN
          IF RxState=Flushing THEN
            RETURN(Result);
          ELSE
            FTSupport.LastMessage := 'Timeout';
            RETURN(3);
          END;
        END;
        CASE RxState OF
          Blk           : RxBlk := ORD(c);
                          RxState := Compl;                               |
          Compl         : IF 255-ORD(c)<>RxBlk THEN
                            Result:=11;
                            FTSupport.LastMessage:='Bad Block No';
                            RxState:=Flushing;
                          ELSIF RxBlk=LastBlockNo THEN
                            Result := 15;
                            RxState := Data;
                          ELSIF RxBlk<>BlockNo THEN
                            Result := 128+10;
                            FTSupport.LastMessage := 'Sequence Error';
                            RxState := Flushing;
                          ELSE
                            RxState := Data;
                          END;                                            |
          Data          : FTSupport.FBuff[Cnt] := c;
                          IF CRCCheck THEN
                            CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(c)));
                            CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8))
                          ELSE
                            CheckSum := (CheckSum+ORD(c)) MOD 100H;
                          END;
                          INC(Cnt);
                          IF Cnt=BlockSize THEN
                            IF CRCCheck THEN
                              RxState:=CRCH;
                            ELSE
                              RxState:=Chk;
                            END;
                          END;                                            |
          Chk           : IF ORD(c)=CheckSum THEN
                            RETURN Result
                          ELSE
                            Result := 8;
                            FTSupport.LastMessage := 'Bad Checksum';
                            RxState := Flushing;
                          END;                                            |
          CRCH          : RxCRC := ORD(c)<<8;
                          RxState := CRCL;                                |
          CRCL          : RxCRC := RxCRC+ORD(c);
                          IF CRC=RxCRC THEN
                            RETURN Result
                          ELSE
                            Result := 9;
                            FTSupport.LastMessage := 'Bad CRC';
                            RxState := Flushing;
                          END;                                            |
          Flushing      : (* do nothing *)                                |
        END; (* case *)
      END; (* loop *)
    END ReceiveData;

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

  PROCEDURE XMReceive():CARDINAL;
    VAR
      c                 : CHAR;
      EOTCount,Result   : CARDINAL;
      IncomingData,
      Negotiating,
      EndOfFile,
      Skippit           : BOOLEAN;
    BEGIN
      Negotiating:=TRUE;
      EOTCount:=0;
      Skippit:=FALSE;
      EndOfFile:=FALSE;
      REPEAT
        IncomingData := FALSE;
        REPEAT
          FTSupport.UpdateStatus;
          IF FTSupport.Aborted THEN
            RETURN(6);
          END;
          IF NOT Skippit THEN
            RS232.SerialWrite(Response,1);
          END;
          Skippit := FALSE;
          LOOP
            IF RS232.SerialRead(c,100) THEN
              IF (c=SOH) OR (c=EOT) OR (c=STX) THEN
                FTSupport.LastMessage:='';
                Negotiating:=FALSE;
                IncomingData := TRUE;
                EXIT;
              END;
            ELSE
              Response := NAK;
              RS232.SerialWrite(Response,1);
              FTSupport.LastMessage := 'Timeout';
              INC(FTSupport.Errors);
              IF FTSupport.Errors>1 THEN
                IF Negotiating THEN
                  RETURN(1);
                ELSE
                  RETURN(2);
                END;
              END;
              EXIT;
            END;
          END;
        UNTIL IncomingData;
        IF c=EOT THEN
          FTSupport.LastMessage := 'End of File';
          INC(EOTCount);
          IF EOTCount=2 THEN
            EndOfFile := TRUE;
            Response:=ACK;
            RS232.SerialWrite(Response,1)
          ELSE
            Response:=NAK; (* NAK first EOT in case it was spurious *)
          END
        ELSE
          EOTCount:=0;
          IF (c=SOH) THEN
            BlockSize:=128;
          ELSE
            BlockSize:=1024;
          END;
          Result := ReceiveData();
          IF Result=0 THEN
            (* ACK a good block immediately so that the background       *)
            (* receiver can be getting the next block while we write     *)
            (* this one to disk.                                         *)
            Response := ACK;
            RS232.SerialWrite(Response,1);
            Skippit := TRUE;
            LastBlockNo := BlockNo;
            BlockNo := (BlockNo+1) MOD 100H;
            IF FTSupport.SizeInBytes>0 THEN
              IF FTSupport.Transferred+LONGCARD(BlockSize)>FTSupport.SizeInBytes THEN
                BlockSize := CARDINAL(FTSupport.SizeInBytes-FTSupport.Transferred);
              END;
            END;
            FIO.WrBin(f,FTSupport.FBuff,BlockSize);
            IF FIO.IOresult()<>0 THEN
              FTSupport.LastMessage := 'Disk Write Error';
              FTSupport.UpdateStatus;
              RETURN(4);
            END;
            FTSupport.Transferred := FTSupport.Transferred+LONGCARD(BlockSize);
            FTSupport.Errors:=0;
            FTSupport.LastMessage:='';
            FTSupport.UpdateStatus;
          ELSIF Result=15 THEN
            (* Sender resent previous block - ACK and ignore *)
            Response := ACK;
            FTSupport.Errors := 0;
            FTSupport.LastMessage := '';
            FTSupport.UpdateStatus;
          ELSE
            INC(FTSupport.Errors);
            FTSupport.UpdateStatus;
            IF Result>127 (*fatal*) THEN
              FTSupport.Aborted := TRUE;
              RETURN(Result MOD 100H)
            END;
            Response := NAK;
            IF FTSupport.Errors>5 (* too many *) THEN
              RETURN(Result);
            END;
          END;
        END;
      UNTIL EndOfFile OR FTSupport.Aborted;
      IF FTSupport.Aborted THEN
        RETURN(6);
      ELSE
        RETURN(0);
      END;
    END XMReceive;

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

  PROCEDURE XModemReceive(VAR Filename:ARRAY OF CHAR):CARDINAL;
    VAR
      Result            : CARDINAL;
      HookSave          : BOOLEAN;
    BEGIN
      InitVars(Filename);
      FTSupport.CompleteFilename;
      f := FIO.Create(FTSupport.FileSpec);
      IF FIO.IOresult()=0 THEN
        HookSave := RS232.Hooked;
        RS232.Hooked := FTSupport.HookOnFT;
        FTSupport.OpenStatusWindow('XModem Download');
        FTSupport.NewFilename;
        Response := CRCREQ;
        Result := XMReceive();
        IF Result=1 THEN
          CRCCheck:=FALSE;
          FTSupport.XferMode:='CHK';
          Response := NAK;
          Result := XMReceive();
        END;
        RS232.Hooked := HookSave;
        FIO.Close(f);
        IF FTSupport.Aborted THEN
          FTSupport.Cancel;
        END;
        FTSupport.CloseStatusWindow;
        RETURN Result;
      ELSE
        CommUtil.ErrorMessage('Could not open file!');
        RETURN 12;
      END;
    END XModemReceive;

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

  PROCEDURE GetResponse(VAR c:CHAR):CARDINAL;
    VAR
      CANCount          : CARDINAL;
      GotResponse       : BOOLEAN;
    BEGIN
      CANCount := 0;
      REPEAT
        IF FTSupport.AbortRequested() THEN
          RETURN(6);
        END;
        IF ResponseWaiting THEN
          c:=Response;
          GotResponse:=TRUE;
          ResponseWaiting:=FALSE
        ELSE
          GotResponse := RS232.SerialRead(c,100);
        END;
        IF GotResponse THEN
          IF c=CAN THEN
            INC(CANCount);
            IF CANCount=3 THEN
              RETURN(13);
            END;
          END;
        ELSE
          FTSupport.LastMessage := 'Timeout';
          INC(FTSupport.Errors);
          FTSupport.UpdateStatus;
          IF FTSupport.Errors=5 THEN
            RETURN(2);
          END;
        END;
      UNTIL GotResponse AND ((c=NAK) OR (c=ACK) OR (c=CRCREQ));
      FTSupport.LastMessage := '';
      FTSupport.UpdateStatus;
      RETURN 0;
    END GetResponse;

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

  PROCEDURE SendBlock(VAR c:CHAR):CARDINAL;
    VAR
      Result,i,Lnth,CRC,
      CheckSum,CRCIndex : CARDINAL;
      Header            : ARRAY[0..2] OF CHAR;
    BEGIN
      CRC:=0;
      CheckSum:=0;
      Lnth:=BlockSize;
      IF Lnth=128 THEN
        Header[0]:=SOH;
      ELSE
        Header[0]:=STX;
      END;
      Header[1]:=CHR(BlockNo);
      Header[2]:=CHR(255-BlockNo);
      RS232.SerialWrite(Header,3);
      IF CRCCheck THEN
        FOR i:=0 TO Lnth-1 DO
          RS232.SerialWrite(FTSupport.FBuff[i],1);
          CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(FTSupport.FBuff[i])));
          CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8))
        END;
        FTSupport.FBuff[Lnth] := CHR(CRC DIV 100H);
        FTSupport.FBuff[Lnth+1] := CHR(CRC MOD 100H);
        RS232.SerialWrite(FTSupport.FBuff[Lnth],2);
        INC(Lnth,2);
      ELSE
        FOR i:=0 TO Lnth-1 DO
          RS232.SerialWrite(FTSupport.FBuff[i],1);
          CheckSum := (CheckSum + ORD(FTSupport.FBuff[i])) MOD 100H;
        END;
        FTSupport.FBuff[Lnth] := CHR(CheckSum);
        RS232.SerialWrite(CHR(CheckSum),1);
        INC(Lnth);
      END;
      REPEAT
        Result := GetResponse(c);
        IF Result<>0 THEN
          RETURN(Result);
        END;
        IF c#ACK THEN
          FTSupport.LastMessage := 'Received NAK';
          INC(FTSupport.Errors);
          FTSupport.UpdateStatus;
          IF FTSupport.Errors=5 THEN
            RETURN(14);
          END;
          RS232.SerialWrite(Header,3);
          RS232.SerialWrite(FTSupport.FBuff,Lnth);
        END;
      UNTIL c=ACK;
      RETURN 0;
    END SendBlock;

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

  PROCEDURE GetStartChar(VAR c:CHAR):CARDINAL;
    VAR
      Result            : CARDINAL;
    BEGIN
      REPEAT
        Result := GetResponse(c);
        IF Result<>0 THEN
          RETURN(Result);
        END;
      UNTIL (c=NAK) OR (c=CRCREQ);
      IF c=NAK THEN
        CRCCheck:=FALSE;
        FTSupport.XferMode:='CHK'
      END;
      RS232.FlushInBuf;
      RETURN 0;
    END GetStartChar;

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

  PROCEDURE XMSend():CARDINAL;
    VAR
      c                 : CHAR;
      Result,BytesRead,
      CANCount          : CARDINAL;
    BEGIN
      Result := GetStartChar(c);
      IF Result<>0 THEN
        RETURN(Result);
      END;
      FTSupport.UpdateStatus;
      WHILE NOT FIO.EOF DO
        BytesRead := FIO.RdBin(f,FTSupport.FBuff,BlockSize);
        IF FIO.IOresult()<>0 THEN
          RETURN(5);
        END;
        IF BytesRead<BlockSize THEN
          Lib.Fill(ADR(FTSupport.FBuff[BytesRead]),BlockSize-BytesRead,CHR(26));
        END;
        FTSupport.Errors := 0;
        Result := SendBlock(c);
        IF Result<>0 THEN
          RETURN(Result);
        END;
        FTSupport.LastMessage := '';
        FTSupport.Transferred := FTSupport.Transferred+LONGCARD(BlockSize);
        BlockNo := (BlockNo+1) MOD 100H;
        FTSupport.Errors := 0;
        FTSupport.UpdateStatus;
      END;
      FTSupport.LastMessage := 'End of File';
      FTSupport.UpdateStatus;
      REPEAT
        REPEAT
          RS232.SerialWrite(EOT,1);
          Result := GetResponse(c);
          IF Result<>0 THEN
            RETURN(Result);
          END;
        UNTIL (c=NAK) OR (c=ACK);
      UNTIL c=ACK;
      RETURN 0;
    END XMSend;

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

  PROCEDURE XModemSend(VAR Filename:ARRAY OF CHAR):CARDINAL;
    VAR
      Result            : CARDINAL;
      HookSave          : BOOLEAN;
    BEGIN
      IF FIO.Exists(Filename) THEN
        HookSave := RS232.Hooked;
        RS232.Hooked := FTSupport.HookOnFT;
        InitVars(Filename);
        f := FIO.Open(Filename);
        FIO.EOF := FALSE;
        FTSupport.SizeInBytes := FIO.Size(f);
        FTSupport.OpenStatusWindow('XModem Upload');
        FTSupport.NewFilename;
        Result := XMSend();
        RS232.Hooked := HookSave;
        FTSupport.CloseStatusWindow;
        FIO.Close(f);
        RETURN Result;
      ELSE
        CommUtil.ErrorMessage('Could not open file!');
        RETURN 7
      END;
    END XModemSend;

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

END XModem.