Columbia Kermit/kermit.zip/os2pm/datalink.mod

Text File | 2020-01-01 | 6KB | 210 lines

IMPLEMENTATION MODULE DataLink;  (* Sends and Receives Packets for PCKermit *)

   FROM ElapsedTime IMPORT
      StartTime, GetTime;

   FROM Screen IMPORT
      ClrScr, WriteString, WriteLn;

   FROM PMWIN IMPORT
      MPARAM, WinPostMsg;

   FROM Shell IMPORT
      ChildFrameWindow, comport;

   FROM CommPort IMPORT
      CommStatus, GetChar, SendChar;

   FROM PAD IMPORT
      PacketType, yourNPAD, yourPADC, yourEOL;

   FROM KH IMPORT
      COM_OFF;

   FROM SYSTEM IMPORT
      BYTE;

   IMPORT ASCII;


   CONST
      MAXtime = 100;   (* hundredths of a second -- i.e., one second *)
      MAXsohtrys = 100;
      DL_BadCS = 1;
      DL_NoSOH = 2;


   TYPE
      SMALLSET = SET OF [0..7];   (* BYTE *)

   VAR
      ch : CHAR;
      status : CommStatus;
      MP1, MP2 : MPARAM;


   PROCEDURE Delay (t : CARDINAL);
   (* delay time in milliseconds *)

      VAR
         tmp : LONGINT;

      BEGIN
         tmp := t DIV 10;
         StartTime;
         WHILE GetTime() < tmp DO
         END;
      END Delay;


   PROCEDURE ByteAnd (a, b : BYTE) : BYTE;
      BEGIN
         RETURN BYTE (SMALLSET (a) * SMALLSET (b));
      END ByteAnd;


   PROCEDURE Char (c : INTEGER) : CHAR;
   (* converts a number 0-95 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 FlushUART;
   (* ensure no characters left in UART holding registers *)
      BEGIN
         Delay (500);
         REPEAT
            status := GetChar (comport - COM_OFF, ch);
         UNTIL status = NoCharacter;
      END FlushUART;


   PROCEDURE SendPacket (s : PacketType);
   (* Adds SOH and CheckSum to packet *)

      VAR
         i : CARDINAL;
         checksum : INTEGER;

      BEGIN
         Delay (10);   (* give host a chance to catch its breath *)
         FOR i := 1 TO yourNPAD DO
            status := SendChar (comport - COM_OFF, yourPADC, FALSE);
         END;
         status := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
         i := 1;
         checksum := 0;
         WHILE s[i] # 0C DO
            INC (checksum, ORD (s[i]));
            status := SendChar (comport - COM_OFF, s[i], FALSE);
            INC (i);
         END;
         checksum := checksum + (INTEGER (BITSET (checksum) * {7, 6}) DIV 64);
         checksum := INTEGER (BITSET (checksum) * {5, 4, 3, 2, 1, 0});
         status := SendChar (comport - COM_OFF, Char (checksum), FALSE);
         IF yourEOL # 0C THEN
            status := SendChar (comport - COM_OFF, yourEOL, FALSE);
         END;
      END SendPacket;


   PROCEDURE ReceivePacket (VAR r : PacketType) : BOOLEAN;
   (* strips SOH and checksum -- returns status: TRUE = good packet     *)
   (* received;  FALSE = timed out waiting for packet or checksum error *)

      VAR
         sohtrys : INTEGER;
         i, len : INTEGER;
         ch : CHAR;
         checksum : INTEGER;
         mycheck, yourcheck : CHAR;

      BEGIN
         sohtrys := MAXsohtrys;
         REPEAT
            StartTime;
            REPEAT
               status := GetChar (comport - COM_OFF, ch);
            UNTIL (status = Success) OR (GetTime() > MAXtime);
            ch := CHAR (ByteAnd (ch, 177C));   (* mask off MSB *)
            (* skip over up to MAXsohtrys padding characters, *)
            (* but allow only MAXsohtrys/10 timeouts          *)
            IF status = Success THEN
               DEC (sohtrys);
            ELSE
               DEC (sohtrys, 10);
            END;
         UNTIL (ch = ASCII.soh) OR (sohtrys <= 0);

         IF ch = ASCII.soh THEN
            (* receive rest of packet *)
            StartTime;
            REPEAT
               status := GetChar (comport - COM_OFF, ch);
            UNTIL (status = Success) OR (GetTime() > MAXtime);
            ch := CHAR (ByteAnd (ch, 177C));
            len := UnChar (ch);
            r[1] := ch;
            checksum := ORD (ch);
            i := 2;   (* on to second character in packet -- after LEN *)
            REPEAT
               StartTime;
               REPEAT
                  status := GetChar (comport - COM_OFF, ch);
               UNTIL (status = Success) OR (GetTime() > MAXtime);
               ch := CHAR (ByteAnd (ch, 177C));
               r[i] := ch;   INC (i);
               INC (checksum, (ORD (ch)));
            UNTIL (i > len);
            (* get checksum character *)
            StartTime;
            REPEAT
               status := GetChar (comport - COM_OFF, ch);
            UNTIL (status = Success) OR (GetTime() > MAXtime);
            ch := CHAR (ByteAnd (ch, 177C));
            yourcheck := ch;
            r[i] := 0C;
            checksum := checksum +
                            (INTEGER (BITSET (checksum) * {7, 6}) DIV 64);
            checksum := INTEGER (BITSET (checksum) *  {5, 4, 3, 2, 1, 0});
            mycheck := Char (checksum);
            IF mycheck = yourcheck THEN   (* checksum OK *)
               RETURN TRUE;
            ELSE   (* ERROR!!! *)
               MP1.W1 := DL_BadCS;   MP1.W2 := 0;
               MP2.L := 0;
               WinPostMsg (ChildFrameWindow, WM_DL, MP1, MP2);
               RETURN FALSE;
            END;
         ELSE
            MP1.W1 := DL_NoSOH;   MP1.W2 := 0;
            MP2.L := 0;
            WinPostMsg (ChildFrameWindow, WM_DL, MP1, MP2);
            RETURN FALSE;
         END;
      END ReceivePacket;


   PROCEDURE DoDLMsg (mp1, mp2 [VALUE] : MPARAM);
   (* Process DataLink Messages *)
      BEGIN
         CASE CARDINAL (mp1.W1) OF
            DL_BadCS:
               WriteString ("Bad Checksum");   WriteLn;
         |  DL_NoSOH:
               WriteString ("No SOH");   WriteLn;
         ELSE
            (* Do Nothing *)
         END;
      END DoDLMsg;

END DataLink.