Topspeed_JPI/TS/SRC/WXMODEM.MOD

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

IMPLEMENTATION MODULE WXModem;
  IMPORT CommUtil,FIO,FTSupport,Lib,RS232,Str;
  FROM FTSupport        IMPORT ACK,NAK,SOH,EOT,CAN,SYN,WNDREQ;

  CONST
    DLE                 = CHR(16);
    XON                 = CHR(17);
    XOFF                = CHR(19);

  VAR
    f                   : FIO.File;
    Response            : ARRAY[0..1] OF CHAR;
    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;
    END InitVars;

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

  PROCEDURE SendResponse;
    BEGIN
      IF (Response[0]=ACK) OR (Response[0]=NAK) THEN
        Response[1] := CHR(ORD(Response[1]) MOD 4);
        RS232.SerialWrite(Response,2)
      ELSIF Response[0]<>0C THEN
        RS232.SerialWrite(Response,1)
      END;
    END SendResponse;

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

  PROCEDURE RcvNoDLE(VAR c:CHAR; Timeout:CARDINAL):BOOLEAN;
    (* Strip DLE sequences from incoming data *)
    BEGIN
      IF RS232.SerialRead(c,Timeout) THEN
        IF c=DLE THEN
          IF RS232.SerialRead(c,Timeout) THEN
            c := CHR(CARDINAL(BITSET(ORD(c))/BITSET(64)))
          ELSE
            RETURN FALSE;
          END;
        END;
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    END RcvNoDLE;

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

  PROCEDURE ReceiveData():CARDINAL;
    (* Attempt to receive a single packet, returning an error code. Zero *)
    (* means that a packet was successfully received.                    *)
    VAR
      c                 : CHAR;
      RxBlk,CRC,RxCRC,
      Result,Cnt,
      CRCIndex          : CARDINAL;
      RxState           : (Start,Blk,Compl,Data,CRCH,CRCL);
    BEGIN
      (* Already had the first character - SYN *)
      RxState:=Start;
      CRC:=0;
      Cnt:=0;
      Result:=0;
      LOOP
        IF FTSupport.AbortRequested() THEN
          RETURN(128+6);
        END;
        IF NOT RcvNoDLE(c,50) THEN
          FTSupport.LastMessage := 'Timeout';
          RETURN(3);
        END;
        CASE RxState OF
          Start         : IF c=SOH THEN
                            RxState:=Blk;
                            BlockSize:=128
                          ELSIF c=EOT THEN
                            RETURN 127;
                          END;                                            |
          Blk           : RxBlk := ORD(c);
                          RxState := Compl;                               |
          Compl         : IF 255-ORD(c)<>RxBlk THEN
                            FTSupport.LastMessage:='Bad Block No';
                            RETURN 11;
                          ELSIF RxBlk=BlockNo THEN
                            RxState := Data;
                          ELSE
                            Result := 15;
                            FTSupport.LastMessage := 'Block Resent';
                            RxState := Data;
                          END;                                            |
          Data          : FTSupport.FBuff[Cnt] := c;
                          CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(c)));
                          CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8));
                          INC(Cnt);
                          IF Cnt=BlockSize THEN
                            RxState:=CRCH;
                          END;                                            |
          CRCH          : RxCRC := ORD(c)<<8;
                          RxState := CRCL;                                |
          CRCL          : RxCRC := RxCRC+ORD(c);
                          IF CRC=RxCRC THEN
                            RETURN Result
                          ELSE
                            FTSupport.LastMessage := 'Bad CRC';
                            RETURN 9;
                          END;                                            |
        END; (* case *)
      END; (* loop *)
    END ReceiveData;

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

  PROCEDURE WXMReceive():CARDINAL;
    VAR
      c                 : CHAR;
      Result            : CARDINAL;
      IncomingData,
      Negotiating,
      EndOfFile         : BOOLEAN;
    BEGIN
      Negotiating:=TRUE;
      EndOfFile:=FALSE;
      REPEAT
        IncomingData := FALSE;
        REPEAT
          FTSupport.UpdateStatus;
          IF FTSupport.AbortRequested() THEN
            RETURN(6);
          END;
          LOOP
            SendResponse;
            IF RS232.SerialRead(c,150) THEN
              IF (c=SYN) OR (c=EOT) THEN
                FTSupport.LastMessage:='';
                Negotiating:=FALSE;
                IncomingData := TRUE;
                EXIT;
              END
            ELSE
              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
          Result := 127
        ELSE
          Result := ReceiveData();
        END;
        IF Result=127 (* end of file *) THEN
          FTSupport.LastMessage := 'End of File';
          EndOfFile := TRUE;
          Response[0]:=ACK;
          RS232.SerialWrite(Response,1)
        ELSIF Result=0 THEN  (* good block received *)
          Response[0]:=ACK;
          Response[1]:=CHR(BlockNo);
          LastBlockNo := BlockNo;
          BlockNo := (BlockNo+1) MOD 100H;
          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 a block - ignore *)
          Response[0] := 0C;
          FTSupport.Errors := 0;
          FTSupport.LastMessage := '';
          FTSupport.UpdateStatus;
        ELSE                 (* protocol error of some kind *)
          INC(FTSupport.Errors);
          FTSupport.UpdateStatus;
          IF Result>127 (* fatal *) THEN
            FTSupport.Aborted := TRUE;
            RETURN(Result MOD 100H)
          END;
          Response[0]:=NAK;
          Response[1]:=CHR(BlockNo);
          IF FTSupport.Errors>5 (* too many *) THEN RETURN(Result) END;
        END;
      UNTIL EndOfFile OR FTSupport.Aborted;
      IF FTSupport.Aborted THEN
        RETURN(6);
      ELSE
        RETURN(0);
      END;
    END WXMReceive;

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

  PROCEDURE WXModemReceive(VAR Filename:ARRAY OF CHAR):CARDINAL;
    VAR
      Result            : CARDINAL;
    BEGIN
      InitVars(Filename);
      FTSupport.CompleteFilename;
      f := FIO.Create(Filename);
      IF FIO.IOresult()=0 THEN
        FTSupport.OpenStatusWindow('WXModem Download');
        FTSupport.NewFilename;
        Response := WNDREQ;
        Result := WXMReceive();
        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 WXModemReceive;

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

  PROCEDURE GetResponse(VAR c:CHAR):CARDINAL;
    VAR
      CANCount          : CARDINAL;
      GotResponse       : BOOLEAN;
    BEGIN
      CANCount := 0;
      REPEAT
        IF FTSupport.AbortRequested() THEN
          RETURN(6);
        END;
        GotResponse := RS232.SerialRead(c,100);
        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=WNDREQ));
      FTSupport.LastMessage := '';
      FTSupport.UpdateStatus;
      RETURN 0;
    END GetResponse;

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

  PROCEDURE SendBlock(VAR Block:ARRAY OF CHAR; BlockNo:CARDINAL);
    (* Send a block out the serial port while calculating a CRC in       *)
    (* parallel, then send the CRC.                                      *)
    VAR
      i,TxCRC,CRC       : CARDINAL;

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

    PROCEDURE Send(c:CHAR);
      VAR
        CRCIndex        : CARDINAL;
      BEGIN
        CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(c)));
        CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8));
        IF (c=DLE) OR (c=SYN) OR (c=XON) OR (c=XOFF) THEN
          RS232.SerialWrite(DLE,1);
          c := CHR(CARDINAL(BITSET(ORD(c))/BITSET(64)))
        END;
        RS232.SerialWrite(c,1);
      END Send;

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

    BEGIN (* SendBlock *)
      RS232.SerialWrite(SYN,1);
      RS232.SerialWrite(SYN,1);
      RS232.SerialWrite(SOH,1);
      Send(CHR(BlockNo));
      Send(CHR(255-BlockNo));
      CRC := 0;
      FOR i:=0 TO 127 DO
        Send(Block[i]);
      END;
      TxCRC := CRC;
      Send(CHR(TxCRC DIV 100H));
      Send(CHR(TxCRC MOD 100H));
    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=WNDREQ);
      RS232.FlushInBuf;
      RETURN 0;
    END GetStartChar;

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

  PROCEDURE WXMSend():CARDINAL;
    CONST
      WindowSize        = 4;
    VAR
      c,Resp            : CHAR;
      Result,BytesRead,
      BlockNo,LastAcked : CARDINAL;
      Buffer            : ARRAY[0..127] OF CHAR;

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

    PROCEDURE CheckWindow(Resp,c:CHAR):CARDINAL;
      VAR
        Temp            : CARDINAL;
      BEGIN
        Temp := LastAcked;
        WHILE ((LastAcked+1) MOD 4)<>ORD(c) DO
          INC(LastAcked);
        END;
        IF Resp=ACK THEN
          INC(LastAcked);
        END;
        IF LastAcked>BlockNo THEN
          (* got ACK for block I havent sent yet!! (eg double ack), forget it *)
          LastAcked := Temp;
          RETURN 0;
        END;
        IF Resp=NAK THEN
          FTSupport.LastMessage := 'Got NAK';
          BlockNo:=LastAcked+1;
          FIO.Seek(f,128*LONGCARD(BlockNo-1));
          INC(FTSupport.Errors);
          IF FTSupport.Errors=10 THEN
            FTSupport.Aborted := TRUE;
            RETURN(6)
          END;
        ELSE
          FTSupport.Errors := 0;
          FTSupport.LastMessage := '';
        END;
        FTSupport.Transferred := LONGCARD(LastAcked)*128;
        FTSupport.UpdateStatus;
        RETURN 0;
      END CheckWindow;

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

    BEGIN (* WXMSend *)
      Result := GetStartChar(c);
      IF Result<>0 THEN
        RETURN(Result);
      END;
      LastAcked := 0;
      BlockNo := 1;
      FTSupport.UpdateStatus;
      WHILE NOT FIO.EOF DO
        WHILE BlockNo-LastAcked>=WindowSize DO
          FTSupport.UpdateStatus;
          REPEAT
            REPEAT
              Result := GetResponse(c);
              IF (Result<>0) AND (Result<>2) THEN
                RETURN(Result); (* dont return on timeout *)
              END;
            UNTIL (c=ACK) OR (c=NAK) OR (Result=2);
            IF Result=0 THEN
              Resp:=c;
              IF NOT RS232.SerialRead(c,150) THEN
                Result:=2;
              END;
            END;
          UNTIL (ORD(c)>=0) AND (ORD(c)<=3) OR (Result=2);
          IF Result=0 THEN
            Result := CheckWindow(Resp,c);
            IF Result<>0 THEN
              RETURN(Result);
            END;
          ELSE
            (* handle timeout by resending last block *)
            DEC(BlockNo);
            FIO.Seek(f,128*LONGCARD(BlockNo-1));
          END;
        END;
        BytesRead := FIO.RdBin(f,Buffer,128);
        IF FIO.IOresult()<>0 THEN
          RETURN(5);
        END;
        IF BytesRead<128 THEN
          Lib.Fill(ADR(Buffer[BytesRead]),128-BytesRead,CHR(26));
        END;
        SendBlock(Buffer,BlockNo MOD 100H);
        INC(BlockNo);
        FTSupport.UpdateStatus;
        LOOP
          IF (RS232.SerialRead(c,0)) AND ((c=ACK) OR (c=NAK)) THEN
            Resp := c;
            IF (RS232.SerialRead(c,150)) AND (c>=0C) AND (c<=3C) THEN
              Result := CheckWindow(Resp,c);
              IF Result<>0 THEN
                RETURN(Result);
              END;
            ELSE
              EXIT;
            END;
          ELSE
            EXIT;
          END;
        END;
      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 WXMSend;

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

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

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

END WXModem.