IMPLEMENTATION MODULE PAD;   (* Packet Assembler/Disassembler for Kermit *)

   FROM SYSTEM IMPORT
      ADR;

   FROM Storage IMPORT
      ALLOCATE, DEALLOCATE;
 
   FROM Screen IMPORT
      ClrScr, WriteString, WriteInt, WriteHex, WriteLn;

   FROM DosCalls IMPORT
      ExitType, DosExit;
 
   FROM Strings IMPORT
      Length, Assign;
 
   FROM FileSystem IMPORT
      File;
 
   FROM Directories IMPORT
      FileAttributes, AttributeSet, DirectoryEntry, FindFirst, FindNext;
 
   FROM Files IMPORT
      Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;

   FROM PMWIN IMPORT
      MPARAM, WinPostMsg;
 
   FROM Shell IMPORT
      ChildFrameWindow, comport;
 
   FROM KH IMPORT
      COM_OFF;
 
   FROM DataLink IMPORT
      FlushUART, SendPacket, ReceivePacket;

   FROM SYSTEM IMPORT
      BYTE;
 
   IMPORT ASCII;
 

   CONST
      myMAXL = 94;
      myTIME = 10;
      myNPAD = 0;
      myPADC = 0C;
      myEOL  = 0C;
      myQCTL = '#';
      myQBIN = '&';
      myCHKT = '1';     (* one character checksum *)
      MAXtrys = 5;
      (* From DEFINITION MODULE:
      PAD_Quit = 0;  *)
      PAD_SendPacket = 1;
      PAD_ResendPacket = 2;
      PAD_NoSuchFile = 3;
      PAD_ExcessiveErrors = 4;
      PAD_ProbClSrcFile = 5;
      PAD_ReceivedPacket = 6;
      PAD_Filename = 7;
      PAD_RequestRepeat = 8;
      PAD_DuplicatePacket = 9;
      PAD_UnableToOpen = 10;
      PAD_ProbClDestFile = 11;
      PAD_ErrWrtFile = 12;
      PAD_Msg = 13;
 
 
   TYPE
      (* From Definition Module:
      PacketType = ARRAY [1..100] OF CHAR;
      *)
      SMALLSET = SET OF [0..7];   (* a byte *)
 
 
   VAR
      yourMAXL : INTEGER;   (* maximum packet length -- up to 94 *)
      yourTIME : INTEGER;   (* time out -- seconds *)
      (* From Definition Module
      yourNPAD : INTEGER;   (* number of padding characters *)
      yourPADC : CHAR;   (* padding characters *)
      yourEOL  : CHAR;   (* End Of Line -- terminator *)
      *)
      yourQCTL : CHAR;   (* character for quoting controls '#' *)
      yourQBIN : CHAR;   (* character for quoting binary '&' *)
      yourCHKT : CHAR;   (* check type -- 1 = checksum, etc. *)
      sF, rF : File;   (* files being sent/received *)
      InputFileOpen : BOOLEAN;
      rFname : ARRAY [0..20] OF CHAR;
      sP, rP : PacketType;   (* packets sent/received *)
      sSeq, rSeq : INTEGER;   (* sequence numbers *)
      PktNbr : INTEGER;   (* actual packet number -- no repeats up to 32,000 *)
      ErrorMsg : ARRAY [0..40] OF CHAR;
      MP1, MP2 : MPARAM;
 

   PROCEDURE PtrToStr (mp [VALUE] : MPARAM; VAR s : ARRAY OF CHAR);
   (* Convert a pointer to a string into a string *)
 
      TYPE
         PC = POINTER TO CHAR;
 
      VAR
         p : PC;
         i : CARDINAL;
         c : CHAR;
 
      BEGIN
         i := 0;
         REPEAT
            p := PC (mp);
            c := p^;
            s[i] := c;
            INC (i);
            INC (mp.L);
         UNTIL c = 0C;
      END PtrToStr;


   PROCEDURE DoPADMsg (mp1, mp2 [VALUE] : MPARAM);
   (* Output messages for Packet Assembler/Disassembler *)
 
      VAR
         Message : ARRAY [0..40] OF CHAR;
 
      BEGIN
         CASE CARDINAL (mp1.W1) OF
            PAD_SendPacket:
               WriteString ("Sent Packet #");
               WriteInt (mp2.W1, 5);
               WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
               WriteString ("h)");
         |  PAD_ResendPacket:
               WriteString ("ERROR -- Resending:");   WriteLn;
               WriteString ("     Packet #");
               WriteInt (mp2.W1, 5);
               WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
               WriteString ("h)");
         |  PAD_NoSuchFile:
               WriteString ("No such file: ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_ExcessiveErrors:
               WriteString ("Excessive errors ...");
         |  PAD_ProbClSrcFile:
               WriteString ("Problem closing source file...");
         |  PAD_ReceivedPacket:
               WriteString ("Received Packet #");
               WriteInt (mp2.W1, 5);
               WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
               WriteString ("h)");
         |  PAD_Filename:
               WriteString ("Filename = ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_RequestRepeat:
               WriteString ("ERROR -- Requesting Repeat:");   WriteLn;
               WriteString ("         Packet #");
               WriteInt (mp2.W1, 5);
               WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
               WriteString ("h)");
         |  PAD_DuplicatePacket:
               WriteString ("Discarding Duplicate:");   WriteLn;
               WriteString ("         Packet #");
               WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
               WriteString ("h)");
         |  PAD_UnableToOpen:
               WriteString ("Unable to open file: ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_ProbClDestFile:
               WriteString ("Error closing file: ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_ErrWrtFile:
               WriteString ("Error writing to file: ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_Msg:
               PtrToStr (mp2, Message);   WriteString (Message);
         ELSE
            (* Do Nothing *)
         END;
         WriteLn;
      END DoPADMsg;
 

   PROCEDURE CloseInput;
   (* Close the input file, if it exists.  Reset Input File Open flag *)
      BEGIN
         IF InputFileOpen THEN
            IF CloseFile (sF, Input) = Done THEN
               InputFileOpen := FALSE;
            ELSE
               MP1.W1 := PAD_ProbClSrcFile;   MP1.W2 := 0;
               MP2.L := LONGINT (ADR (sFname));
               WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            END;
         END;
      END CloseInput;
 
 
   PROCEDURE NormalQuit;
   (* Exit from Thread, Post message to Window *)
      BEGIN
         MP1.W1 := PAD_Quit;   MP1.W2 := 0;
         MP1.L := 0;
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         DosExit (EXIT_THREAD, 0);
      END NormalQuit;
 
 
   PROCEDURE ErrorQuit;
   (* Exit from Thread, Post message to Window *)
      BEGIN
         MP1.W1 := PAD_Error;   MP1.W2 := 0;
         MP2.L := 0;
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         DosExit (EXIT_THREAD, 0);
      END ErrorQuit;
 
 
   PROCEDURE ByteXor (a, b : BYTE) : BYTE;
      BEGIN
         RETURN BYTE (SMALLSET (a) / SMALLSET (b));
      END ByteXor;
 
 
   PROCEDURE Char (c : INTEGER) : CHAR;
   (* converts a number 0-94 into a printable character *)
      BEGIN
         RETURN (CHR (CARDINAL (ABS (c) + 32)));
      END Char;
 
 
   PROCEDURE UnChar (c : CHAR) : INTEGER;
   (* converts a character into its corresponding number *)
      BEGIN
         RETURN (ABS (INTEGER (ORD (c)) - 32));
      END UnChar;

 
   PROCEDURE TellError (Seq : INTEGER);
   (* Send error packet *)
      BEGIN
         sP[1] := Char (15);
         sP[2] := Char (Seq);
         sP[3] := 'E';   (* E-type packet *)
         sP[4] := 'R';   (* error message starts *)
         sP[5] := 'e';
         sP[6] := 'm';
         sP[7] := 'o';
         sP[8] := 't';
         sP[9] := 'e';
         sP[10] := ' ';
         sP[11] := 'A';
         sP[12] := 'b';
         sP[13] := 'o';
         sP[14] := 'r';
         sP[15] := 't';
         sP[16] := 0C;
         SendPacket (sP);
      END TellError;
 
 
   PROCEDURE ShowError (p : PacketType);
   (* Output contents of error packet to the screen *)
 
      VAR
         i : INTEGER;
 
      BEGIN
         FOR i := 4 TO UnChar (p[1]) DO
            ErrorMsg[i - 4] := p[i];
         END;
         ErrorMsg[i - 4] := 0C;
         MP1.W1 := PAD_Msg;   MP1.W2 := 0;
         MP2.L := LONGINT (ADR (ErrorMsg));
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
      END ShowError;
 
 
   PROCEDURE youInit (type : CHAR);
   (* I initialization YOU for Send and Receive *)
      BEGIN
         sP[1] := Char (11);   (* Length *)
         sP[2] := Char (0);   (* Sequence *)
         sP[3] := type;
         sP[4] := Char (myMAXL);
         sP[5] := Char (myTIME);
         sP[6] := Char (myNPAD);
         sP[7] := CHAR (ByteXor (myPADC, 100C));
         sP[8] := Char (ORD (myEOL));
         sP[9] := myQCTL;
         sP[10] := myQBIN;
         sP[11] := myCHKT;
         sP[12] := 0C;   (* terminator *)
         SendPacket (sP);
      END youInit;
 

   PROCEDURE myInit;
   (* YOU initialize ME for Send and Receive *)
 
      VAR
         len : INTEGER;
 
      BEGIN
         len := UnChar (rP[1]);
         IF len >= 4 THEN
            yourMAXL := UnChar (rP[4]);
         ELSE
            yourMAXL := 94;
         END;
         IF len >= 5 THEN
            yourTIME := UnChar (rP[5]);
         ELSE
            yourTIME := 10;
         END;
         IF len >= 6 THEN
            yourNPAD := UnChar (rP[6]);
         ELSE
            yourNPAD := 0;
         END;
         IF len >= 7 THEN
            yourPADC := CHAR (ByteXor (rP[7], 100C));
         ELSE
            yourPADC := 0C;
         END;
         IF len >= 8 THEN
            yourEOL := CHR (UnChar (rP[8]));
         ELSE
            yourEOL := 0C;
         END;
         IF len >= 9 THEN
            yourQCTL := rP[9];
         ELSE
            yourQCTL := 0C;
         END;
         IF len >= 10 THEN
            yourQBIN := rP[10];
         ELSE
            yourQBIN := 0C;
         END;
         IF len >= 11 THEN
            yourCHKT := rP[11];
            IF yourCHKT # myCHKT THEN
               yourCHKT := '1';
            END;
         ELSE
            yourCHKT := '1';
         END;
      END myInit;
 
 
   PROCEDURE SendInit;
      BEGIN
         youInit ('S');
      END SendInit;
 
 
   PROCEDURE SendFileName;
 
      VAR
         i, j : INTEGER;
 
      BEGIN
         (* send file name *)
         i := 4;   j := 0;
         WHILE sFname[j] # 0C DO
            sP[i] := sFname[j];
            INC (i);   INC (j);
         END;
         sP[1] := Char (j + 3);
         sP[2] := Char (sSeq);
         sP[3] := 'F';   (* filename packet *)
         sP[i] := 0C;
         SendPacket (sP);
      END SendFileName;
 
 
   PROCEDURE SendEOF;
      BEGIN
         sP[1] := Char (3);
         sP[2] := Char (sSeq);
         sP[3] := 'Z';   (* end of file *)
         sP[4] := 0C;
         SendPacket (sP);
      END SendEOF;
 
 
   PROCEDURE SendEOT;
      BEGIN
         sP[1] := Char (3);
         sP[2] := Char (sSeq);
         sP[3] := 'B';   (* break -- end of transmit *)
         sP[4] := 0C;
         SendPacket (sP);
      END SendEOT;
 
 
   PROCEDURE GetAck() : BOOLEAN;
   (* Look for acknowledgement -- retry on timeouts or NAKs *)
 
      VAR
         Type : CHAR;
         Seq : INTEGER;
         retrys : INTEGER;
         AckOK : BOOLEAN;
 
      BEGIN
         MP1.W1 := PAD_SendPacket;   MP1.W2 := 0;
         MP2.W1 := PktNbr;   MP2.W2 := sSeq;
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
 
         retrys := MAXtrys;
         LOOP
            IF Aborted THEN
               TellError (sSeq);
               CloseInput;
               ErrorQuit;
            END;
            IF ReceivePacket (rP) THEN
               Seq := UnChar (rP[2]);
               Type := rP[3];
               IF (Seq = sSeq) AND (Type = 'Y') THEN
                  AckOK := TRUE;
               ELSIF (Seq = (sSeq + 1) MOD 64) AND (Type = 'N') THEN
                  AckOK := TRUE;   (* NAK for (n + 1) taken as ACK for n *)
               ELSIF Type = 'E' THEN
                  ShowError (rP);
                  AckOK := FALSE;
                  retrys := 0;
               ELSE
                  AckOK := FALSE;
               END;
            ELSE
               AckOK := FALSE;
            END;
            IF AckOK OR (retrys = 0) THEN
               EXIT;
            ELSE
               MP1.W1 := PAD_ResendPacket;   MP1.W2 := 0;
               MP2.W1 := PktNbr;   MP2.W2 := sSeq;
               WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
 
               DEC (retrys);
               FlushUART;
               SendPacket (sP);
            END;
         END;
 
         IF AckOK THEN
            INC (PktNbr);
            sSeq := (sSeq + 1) MOD 64;
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END;
      END GetAck;
 

   PROCEDURE GetInitAck() : BOOLEAN;
   (* configuration for remote station *)
      BEGIN
         IF GetAck() THEN
            myInit;
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END;
      END GetInitAck;
 
 
   PROCEDURE Send;
   (* Send one or more files: sFname may be ambiguous *)
 
      TYPE
         LP = POINTER TO LIST;   (* list of filenames *)
         LIST = RECORD
                   fn : ARRAY [0..20] OF CHAR;
                   next : LP;
                END;
 
      VAR
         gotFN : BOOLEAN;
         attr : AttributeSet;
         ent : DirectoryEntry;
         front, back, t : LP;   (* add at back of queue, remove from front *)
 
      BEGIN
         Aborted := FALSE;
         InputFileOpen := FALSE;
 
         front := NIL;   back := NIL;
         attr := AttributeSet {};   (* normal files only *)
         IF Length (sFname) = 0 THEN
            MP1.W1 := PAD_Msg;   MP1.W2 := 0;
            MP2.L := LONGINT (ADR ("No file specified..."));
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            ErrorQuit;
         ELSE
            gotFN := FindFirst (sFname, attr, ent);
            WHILE gotFN DO   (* build up a list of file names *)
               ALLOCATE (t, SIZE (LIST));
               Assign (ent.name, t^.fn);
               t^.next := NIL;
               IF front = NIL THEN
                  front := t;   (* start from empty queue *)
               ELSE
                  back^.next := t;   (* and to back of queue *)
               END;
               back := t;
               gotFN := FindNext (ent);
            END;
         END;
 
         IF front = NIL THEN
            MP1.W1 := PAD_NoSuchFile;   MP1.W2 := 0;
            MP2.L := LONGINT (ADR (sFname));
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            ErrorQuit;
         ELSE
            sSeq := 0;   PktNbr := 0;
            FlushUART;
            SendInit;   (* my configuration information *)
            IF NOT GetInitAck() THEN     (* get your configuration information *)
               MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
               MP2.L := 0;
               WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
               ErrorQuit;
            END;
 
            WHILE front # NIL DO   (* send the files *)
               Assign (front^.fn, sFname);
               PktNbr := 1;
               Send1;
               t := front;
               front := front^.next;
               DEALLOCATE (t, SIZE (LIST));
            END;
         END;
 
         SendEOT;
         IF NOT GetAck() THEN
            MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
            MP2.L := 0;
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            CloseInput;
            ErrorQuit;
         END;
         NormalQuit;
      END Send;
 
 
   PROCEDURE Send1;
   (* Send one file: sFname *)
 
      VAR
         ch : CHAR;
         i : INTEGER;
 
      BEGIN
         IF Open (sF, sFname) = Done THEN
            InputFileOpen := TRUE;
         ELSE;
            MP1.W1 := PAD_NoSuchFile;   MP1.W2 := 0;
            MP2.L := LONGINT (ADR (sFname));
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            ErrorQuit;
         END;
 
         MP1.W1 := PAD_Filename;   MP1.W2 := 0;
         MP2.L := LONGINT (ADR (sFname));
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         MP1.W1 := PAD_Msg;   MP1.W2 := 0;
         MP2.L := LONGINT (ADR ("(<ESC> to abort file transfer.)"));
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
 
         SendFileName;
         IF NOT GetAck() THEN
            MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
            MP2.L := 0;
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            CloseInput;
            ErrorQuit;
         END;
 
         (* send file *)
         i := 4;
         LOOP
            IF Get (sF, ch) = EOF THEN   (* send current packet & terminate *)
               sP[1] := Char (i - 1);
               sP[2] := Char (sSeq);
               sP[3] := 'D';   (* data packet *)
               sP[i] := 0C;   (* indicate end of packet *)
               SendPacket (sP);
               IF NOT GetAck() THEN
                  MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                  MP2.L := 0;
                  WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                  CloseInput;
                  ErrorQuit;
               END;
               SendEOF;
               IF NOT GetAck() THEN
                  MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                  MP2.L := 0;
                  WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                  CloseInput;
                  ErrorQuit;
               END;
               EXIT;
            END;
 
            IF i >= (yourMAXL - 4) THEN   (* send current packet *)
               sP[1] := Char (i - 1);
               sP[2] := Char (sSeq);
               sP[3] := 'D';
               sP[i] := 0C;
               SendPacket (sP);
               IF NOT GetAck() THEN
                  MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                  MP2.L := 0;
                  WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                  CloseInput;
                  ErrorQuit;
               END;
               i := 4;
            END;

            (* add character to current packet -- update count *)
            IF ch > 177C THEN   (* must be quoted (QBIN) and altered *)
               (* toggle bit 7 to turn it off *)
               ch := CHAR (ByteXor (ch, 200C));
               sP[i] := myQBIN;   INC (i);
            END;
            IF (ch < 40C) OR (ch = 177C) THEN   (* quote (QCTL) and alter *)
               (* toggle bit 6 to turn it on *)
               ch := CHAR (ByteXor (ch, 100C));
               sP[i] := myQCTL;   INC (i);
            END;
            IF (ch = myQCTL) OR (ch = myQBIN) THEN   (* must send it quoted *)
               sP[i] := myQCTL;   INC (i);
            END;
            sP[i] := ch;   INC (i);
         END;   (* loop *)
 
         CloseInput;
      END Send1;
 

   PROCEDURE ReceiveInit() : BOOLEAN;
   (* receive my initialization information from you *)
 
      VAR
         RecOK : BOOLEAN;
         trys : INTEGER;
 
      BEGIN
         trys := 1;
         LOOP
            IF Aborted THEN
               TellError (rSeq);
               ErrorQuit;
            END;
            RecOK := ReceivePacket (rP) AND (rP[3] = 'S');
            IF RecOK OR (trys = MAXtrys) THEN
               EXIT;
            ELSE
               INC (trys);
               SendNak;
            END;
         END;
 
         IF RecOK THEN
            myInit;
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END;
      END ReceiveInit;
 
 
   PROCEDURE SendInitAck;
   (* acknowledge your initialization of ME and send mine for YOU *)
      BEGIN
         MP1.W1 := PAD_ReceivedPacket;   MP1.W2 := 0;
         MP2.W1 := PktNbr;   MP2.W2 := rSeq;
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         INC (PktNbr);
         rSeq := (rSeq + 1) MOD 64;
         youInit ('Y');
      END SendInitAck;
 
 
   PROCEDURE ValidFileChar (VAR ch : CHAR) : BOOLEAN;
   (* checks if character is one of 'A'..'Z', '0'..'9', makes upper case *)
      BEGIN
         ch := CAP (ch);
         RETURN ((ch >= 'A') AND (ch <= 'Z')) OR ((ch >= '0') AND (ch <= '9'));
      END ValidFileChar;


   TYPE
      HeaderType = (name, eot, fail);
 
   PROCEDURE ReceiveHeader() : HeaderType;
   (* receive the filename -- alter for local conditions, if necessary *)
 
      VAR
         i, j, k : INTEGER;
         RecOK : BOOLEAN;
         trys : INTEGER;
 
      BEGIN
         trys := 1;
         LOOP
            IF Aborted THEN
               TellError (rSeq);
               ErrorQuit;
            END;
            RecOK := ReceivePacket (rP) AND ((rP[3] = 'F') OR (rP[3] = 'B'));
            IF trys = MAXtrys THEN
               RETURN fail;
            ELSIF RecOK AND (rP[3] = 'F') THEN
               i := 4;   (* data starts here *)
               j := 0;   (* beginning of filename string *)
               WHILE (ValidFileChar (rP[i])) AND (j < 8) DO
                  rFname[j] := rP[i];
                  INC (i);   INC (j);
               END;
               REPEAT
                  INC (i);
               UNTIL (ValidFileChar (rP[i])) OR (rP[i] = 0C);
               rFname[j] := '.';   INC (j);
               k := 0;
               WHILE (ValidFileChar (rP[i])) AND (k < 3) DO
                  rFname[j + k] := rP[i];
                  INC (i);   INC (k);
               END;
               rFname[j + k] := 0C;
               MP1.W1 := PAD_Filename;   MP1.W2 := 0;
               MP2.L := LONGINT (ADR (rFname));
               WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
               RETURN name;
            ELSIF RecOK AND (rP[3] = 'B') THEN
               RETURN eot;
            ELSE
               INC (trys);
               SendNak;
            END;
         END;
      END ReceiveHeader;
 
 
   PROCEDURE SendNak;
      BEGIN
         MP1.W1 := PAD_RequestRepeat;   MP1.W2 := 0;
         MP2.W1 := PktNbr;   MP2.W2 := rSeq;
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         FlushUART;
         sP[1] := Char (3);   (* LEN *)
         sP[2] := Char (rSeq);
         sP[3] := 'N';   (* negative acknowledgement *)
         sP[4] := 0C;
         SendPacket (sP);
      END SendNak;
 
 
   PROCEDURE SendAck (Seq : INTEGER);
      BEGIN
         IF Seq # rSeq THEN
            MP1.W1 := PAD_DuplicatePacket;   MP1.W2 := 0;
            MP2.W1 := 0;   MP2.W2 := rSeq;
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         ELSE
            MP1.W1 := PAD_ReceivedPacket;   MP1.W2 := 0;
            MP2.W1 := PktNbr;   MP2.W2 := rSeq;
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            rSeq := (rSeq + 1) MOD 64;
            INC (PktNbr);
         END;
 
         sP[1] := Char (3);
         sP[2] := Char (Seq);
         sP[3] := 'Y';   (* acknowledgement *)
         sP[4] := 0C;
         SendPacket (sP);
      END SendAck;
 
 
   PROCEDURE Receive;
   (* Receives a file  (or files) *)
 
      VAR
         ch, Type : CHAR;
         Seq : INTEGER;
         i : INTEGER;
         EOF, EOT, QBIN : BOOLEAN;
         trys : INTEGER;
 
      BEGIN
         Aborted := FALSE;
 
         MP1.W1 := PAD_Msg;   MP1.W2 := 0;
         MP2.L := LONGINT (ADR ("Ready to receive file(s)..."));
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         MP1.W1 := PAD_Msg;   MP1.W2 := 0;
         MP2.L := LONGINT (ADR ("(<ESC> to abort file transfer.)"));
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);

         FlushUART;
         rSeq := 0;   PktNbr := 0;
         IF NOT ReceiveInit() THEN   (* your configuration information *)
            MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
            MP2.L := 0;
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            ErrorQuit;
         END;
         SendInitAck;       (* send my configuration information *)
         EOT := FALSE;
         WHILE NOT EOT DO
            CASE ReceiveHeader() OF
               eot  : EOT := TRUE;   EOF := TRUE;
            |  name : IF Create (rF, rFname) # Done THEN
                         MP1.W1 := PAD_UnableToOpen;   MP1.W2 := 0;
                         MP2.L := LONGINT (ADR (rFname));
                         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                         ErrorQuit;
                      ELSE
                         PktNbr := 1;
                         EOF := FALSE;
                      END;
            |  fail : MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                      MP2.L := 0;
                      WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                      ErrorQuit;
            END;
            SendAck (rSeq);   (* acknowledge for name or eot *)
            trys := 1;   (* initialize *)
            WHILE NOT EOF DO
               IF Aborted THEN
                  TellError (rSeq);
                  ErrorQuit;
               END;
               IF ReceivePacket (rP) THEN
                  Seq := UnChar (rP[2]);
                  Type := rP[3];
                  IF Type = 'Z' THEN
                     EOF := TRUE;
                     IF CloseFile (rF, Output) = Done THEN
                        (* normal file termination *)
                     ELSE
                        MP1.W1 := PAD_ProbClDestFile;   MP1.W2 := 0;
                        MP2.L := LONGINT (ADR (rFname));
                        WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                        ErrorQuit;
                     END;
                     trys := 1;   (* good packet -- reset *)
                     SendAck (rSeq);
                  ELSIF Type = 'E' THEN
                     ShowError (rP);
                     ErrorQuit;
                  ELSIF (Type = 'D') AND ((Seq + 1) MOD 64 = rSeq) THEN
                  (* discard duplicate packet, and Ack anyway *)
                     trys := 1;
                     SendAck (Seq);
                  ELSIF (Type = 'D') AND (Seq = rSeq) THEN
                     (* put packet into file buffer *)
                     i := 4;   (* first data in packet *)
                     WHILE rP[i] # 0C DO
                        ch := rP[i];   INC (i);
                        IF ch = yourQBIN THEN
                           ch := rP[i];   INC (i);
                           QBIN := TRUE;
                        ELSE
                           QBIN := FALSE;
                        END;
                        IF ch = yourQCTL THEN
                           ch := rP[i];   INC (i);
                           IF (ch # yourQCTL) AND (ch # yourQBIN) THEN
                              ch := CHAR (ByteXor (ch, 100C));
                           END;
                        END;
                        IF QBIN THEN
                           ch := CHAR (ByteXor (ch, 200C));
                        END;
                        Put (ch);
                     END;
 
                     (* write file buffer to disk *)
                     IF DoWrite (rF) # Done THEN
                        MP1.W1 := PAD_ErrWrtFile;   MP1.W2 := 0;
                        MP2.L := LONGINT (ADR (rFname));
                        WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                        ErrorQuit;
                     END;
                     trys := 1;
                     SendAck (rSeq);
                  ELSE
                     INC (trys);
                     IF trys = MAXtrys THEN
                        MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                        MP2.L := 0;
                        WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                        ErrorQuit;
                     ELSE
                        SendNak;
                     END;
                  END;
               ELSE
                  INC (trys);
                  IF trys = MAXtrys THEN
                     MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                     MP2.L := 0;
                     WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                     ErrorQuit;
                  ELSE
                     SendNak;
                  END;
               END;
            END;
         END;
         NormalQuit;
      END Receive;
 
 
BEGIN   (* module initialization *)
   yourEOL := ASCII.cr;
   yourNPAD := 0;
   yourPADC := 0C;
END PAD.