Category : Files from Magazines
Archive   : DDJ0589.ZIP
Filename : KERMIT.ASC

_Kermit Meets Modula-2_
by Brian Anderson


[LISTING ONE]

MODULE PCKermit;

FROM Break IMPORT
DisableBreak, EnableBreak;

FROM Terminal IMPORT
WriteString, WriteLn, Read;

FROM Shell IMPORT
dispOpts, Options, Dir, Connect, eXit, MainHelp;

FROM PAD IMPORT
Send, Receive;


VAR
Quit : BOOLEAN;
ch : CHAR;


BEGIN (* main program *)
DisableBreak; (* don't recognize Control-C *)
WriteLn; WriteLn;
WriteString ("Welcome to PCKermit -- Mainframe to Micro Communications");
WriteLn;
dispOpts;
Quit := FALSE;
REPEAT
WriteLn; WriteLn;
WriteString ("PCKermit [O, C, D, S, R, X, ?]: ");
LOOP
Read (ch);
CASE CAP (ch) OF
'O' : Options; EXIT;
| 'C' : Connect; EXIT;
| 'D' : Dir; EXIT;
| 'S' : Send; EXIT;
| 'R' : Receive; EXIT;
| 'X' : eXit (Quit); EXIT;
| '?' : MainHelp; EXIT;
ELSE
(* ignore *)
END;
END;
UNTIL Quit;
EnableBreak;
END PCKermit.

[LISTING TWO]

DEFINITION MODULE Shell; (* User interface for Kermit *)

EXPORT QUALIFIED
dispOpts, Options, Dir, Connect, eXit, MainHelp;

PROCEDURE dispOpts;
(* Display communications parameters for the user *)

PROCEDURE Options;
(* set communications options *)

PROCEDURE Dir;
(* Displays a directory *)

PROCEDURE Connect;
(* Terminal mode allows connection to host (possibly through MODEM) *)

PROCEDURE eXit (VAR q : BOOLEAN);
(* Allow user to exit program after prompting for confirmation *)

PROCEDURE MainHelp;
(* help menu for main program loop *)

END Shell.



[LISTING THREE]


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

EXPORT QUALIFIED
PacketType, yourNPAD, yourPADC, yourEOL, Send, Receive;

TYPE
(* PacketType used in both PAD and DataLink modules *)
PacketType = ARRAY [1..100] OF CHAR;

VAR
(* yourNPAD, yourPADC, and yourEOL used in both PAD and DataLink *)
yourNPAD : CARDINAL; (* number of padding characters *)
yourPADC : CHAR; (* padding characters *)
yourEOL : CHAR; (* End Of Line -- terminator *)

PROCEDURE Send;
(* Sends a file after prompting for filename *)

PROCEDURE Receive;
(* Receives a file (or files) *)

END PAD.


[LISTING FOUR]


DEFINITION MODULE Files; (* File I/O for Kermit *)

FROM FileSystem IMPORT
File;

EXPORT QUALIFIED
Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;

TYPE
Status = (Done, Error, EOF);
FileType = (Input, Output);

PROCEDURE Open (VAR f : File; name : ARRAY OF CHAR) : Status;
(* opens an existing file for reading, returns status *)

PROCEDURE Create (VAR f : File; name : ARRAY OF CHAR) : Status;
(* creates a new file for writing, returns status *)

PROCEDURE CloseFile (VAR f : File; Which : FileType) : Status;
(* closes a file after reading or writing *)

PROCEDURE Get (VAR f : File; VAR ch : CHAR) : Status;
(* Reads one character from the file, returns status *)

PROCEDURE Put (ch : CHAR);
(* Writes one character to the file buffer *)

PROCEDURE DoWrite (VAR f : File) : Status;
(* Writes buffer to disk only if nearly full *)

END Files.



[LISTING FIVE]

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

FROM PAD IMPORT
PacketType;

EXPORT QUALIFIED
FlushUART, SendPacket, ReceivePacket;

PROCEDURE FlushUART;
(* ensure no characters left in UART holding registers *)

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

PROCEDURE ReceivePacket (VAR r : PacketType) : BOOLEAN;
(* strips SOH and checksum -- return FALSE if timed out or bad checksum *)

END DataLink.



[LISTING SIX]


IMPLEMENTATION MODULE Shell; (* User interface for Kermit *)

FROM SYSTEM IMPORT
AX, BX, CX, DX, SETREG, SWI;

FROM Exec IMPORT
DosCommand;

FROM Terminal IMPORT
WriteString, WriteLn, KeyPressed, ReadString;

IMPORT Terminal; (* for Terminal.Write and Terminal.Read *)

FROM InOut IMPORT
WriteCard;

FROM RS232Int IMPORT
Init, StartReading, StopReading;

IMPORT RS232Int; (* for RS232Int.Write and RS232Int.BusyRead *)

FROM Strings IMPORT
Length, Concat;

FROM NumberConversion IMPORT
StringToCard;

IMPORT ASCII;


VAR
baudRate : CARDINAL;
stopBits : CARDINAL;
parityBit : BOOLEAN;
evenParity : BOOLEAN;
nbrOfBits : CARDINAL;
OK : BOOLEAN;
echo : (Off, Local, On);
ch : CHAR;
str : ARRAY [0..10] OF CHAR;
n : CARDINAL;


PROCEDURE Initialize;
BEGIN
Init (baudRate, stopBits, parityBit, evenParity, nbrOfBits, OK);
END Initialize;


PROCEDURE ClrScr;
(* Clear the screen, and home the cursor *)
BEGIN
SETREG (AX, 0600H); (* function 6 = scroll or clear window *)
SETREG (BX, 0700H); (* 7 = normal screen attribute *)
SETREG (CX, 0000H); (* top LH of screen *)
SETREG (DX, 184FH); (* bottom RH of screen *)
SWI (10H); (* call bios *)
SETREG (AX, 0200h); (* function 2 = position cursor *)
SETREG (BX, 0000H); (* page 0 *)
SETREG (DX, 0000H); (* home position *)
SWI (10H); (* call bios *)
END ClrScr;


PROCEDURE CommHelp;
(* help menu for communications options *)
BEGIN
ClrScr;
WriteString (" C o m m u n i c a t i o n s O p t i o n s");
WriteLn;
WriteString (" H e l p M e n u");
WriteLn; WriteLn;
WriteString ("set Baud rate ................................ B");
WriteLn;
WriteString ("set Parity ................................... P");
WriteLn;
WriteString ("set Word length .............................. W");
WriteLn;
WriteString ("set Stop bits ................................ S");
WriteLn;
WriteString ("eXit ......................................... X");
WriteLn;
END CommHelp;


PROCEDURE dispOpts;
(* Display communications parameters for the user *)
BEGIN
WriteLn;
WriteString ("Baud rate = "); WriteCard (baudRate, 0);
WriteString ("; ");
IF parityBit THEN
IF evenParity THEN
WriteString ("Even ");
ELSE
WriteString ("Odd ");
END;
ELSE
WriteString ("No ");
END;
WriteString ("parity; ");
WriteCard (nbrOfBits, 0);
WriteString (" Data bits; ");
IF stopBits = 1 THEN
WriteString ("One stop bit.");
ELSE
WriteString ("Two stop bits.");
END;
WriteLn;
END dispOpts;


PROCEDURE Options;
(* set communications options *)

VAR
Quit : BOOLEAN;

BEGIN
ClrScr;
Quit := FALSE;
dispOpts;

REPEAT
WriteLn; WriteLn;
WriteString ("Set Communications Options [B, P, W, S, X, ?]: ");
LOOP
Terminal.Read (ch);
CASE CAP (ch) OF
'B' : Baud; EXIT;
| 'P' : Parity; EXIT;
| 'W' : Word; EXIT;
| 'S' : Stops; EXIT;
| '?' : CommHelp; EXIT;
| 'X' : Quit := TRUE; EXIT;
ELSE
(* ignore *)
END;
END;
IF Quit THEN
ClrScr;
ELSE
Initialize;
dispOpts;
END;
UNTIL Quit;
END Options;


PROCEDURE Baud;
(* Allow user to change the bit rate of the communications port *)
BEGIN
WriteString ("Baud Rate? [110 - 9600]: ");
ReadString (str);
IF Length (str) # 0 THEN
StringToCard (str, n, OK);
IF OK THEN
CASE n OF
110, 150, 300, 600, 1200, 2400, 4800, 9600 : baudRate := n;
ELSE
(* do nothing *)
END;
END;
END;
END Baud;


PROCEDURE Word;
(* Allow user to change the word length of the communications port *)
BEGIN
WriteString ("Word Length? [7, 8]: ");
ReadString (str);
IF Length (str) # 0 THEN
StringToCard (str, n, OK);
IF OK AND (n IN {7, 8}) THEN
nbrOfBits := n;
END;
END;
END Word;


PROCEDURE Parity;
(* Allow user to change the parity bit of the communications port *)
BEGIN
WriteString ("Parity? [None, Even, Odd]: ");
ReadString (str);
IF Length (str) # 0 THEN
CASE CAP (str[0]) OF
'N' : parityBit := FALSE;
| 'E' : parityBit := TRUE; evenParity := TRUE;
| 'O' : parityBit := TRUE; evenParity := FALSE;
ELSE
(* no action *)
END;
END;
END Parity;


PROCEDURE Stops;
(* Allow user to change the number of stop bits *)
BEGIN
WriteString ("Stop Bits? [1, 2]: ");
ReadString (str);
IF Length (str) # 0 THEN
StringToCard (str, n, OK);
IF OK AND (n IN {1, 2}) THEN
stopBits := n;
END;
END;
END Stops;


PROCEDURE Dir;

VAR
done, gotFN : BOOLEAN;
path : ARRAY [0..60] OF CHAR;
filename : ARRAY [0..20] OF CHAR;
i, j, k : INTEGER;

BEGIN
filename := ""; (* in case no directory change *)
WriteString ("Path? (*.*): ");
ReadString (path);
i := Length (path);
IF i # 0 THEN
gotFN := FALSE;
WHILE (i >= 0) AND (path[i] # '\') DO
IF path[i] = '.' THEN
gotFN := TRUE;
END;
DEC (i);
END;
IF gotFN THEN
j := i + 1;
k := 0;
WHILE path[j] # 0C DO
filename[k] := path[j];
INC (k); INC (j);
END;
filename[k] := 0C;
IF (i = -1) OR (i = 0) AND (path[0] = '\')) THEN
INC (i);
END;
path[i] := 0C;
END;
END;
IF Length (path) # 0 THEN
DosCommand ("CHDIR", path, done);
END;
IF Length (filename) = 0 THEN
filename := "*.*";
END;
Concat (filename, "/w", filename);
ClrScr;
DosCommand ("DIR", filename, done);
END Dir;


PROCEDURE ConnectHelp;
(* provide help while in connect mode *)
BEGIN
ClrScr;
WriteString ("LOCAL COMMANDS:"); WriteLn;
WriteString ("^E = Echo mode"); WriteLn;
WriteString ("^L = Local echo mode"); WriteLn;
WriteString ("^T = Terminal mode (no echo)"); WriteLn;
WriteString ("^X = eXit from connect"); WriteLn;
WriteLn; WriteLn;
END ConnectHelp;


PROCEDURE Connect;
(* Terminal mode allows connection to host (possibly through MODEM) *)

VAR
Input : BOOLEAN;

BEGIN
ConnectHelp;
REPEAT
RS232Int.BusyRead (ch, Input);
IF Input THEN
IF ((ch >= 40C) AND (ch < 177C))
OR (ch = ASCII.cr) OR (ch = ASCII.lf) OR (ch = ASCII.bs) THEN
Terminal.Write (ch);
END;
IF echo = On THEN
RS232Int.Write (ch);
END;
END;

IF KeyPressed() THEN
Terminal.Read (ch);
IF ch = ASCII.enq THEN (* Control-E *)
echo := On;
ELSIF ch = ASCII.ff THEN (* Control-L *)
echo := Local;
ELSIF ch = ASCII.dc4 THEN (* Control-T *)
echo := Off;
ELSIF ((ch >= 40C) AND (ch < 177C))
OR (ch = ASCII.EOL) OR (ch = ASCII.bs) THEN
IF ch = ASCII.EOL THEN
RS232Int.Write (ASCII.cr);
RS232Int.Write (ASCII.lf);
ELSE
RS232Int.Write (ch);
END;
IF (echo = On) OR (echo = Local) THEN
Terminal.Write (ch);
END;
END;
END;
UNTIL ch = ASCII.can; (* Control-X *)
END Connect;


PROCEDURE eXit (VAR q : BOOLEAN);
(* Allow user to exit program after prompting for confirmation *)
BEGIN
WriteString ("Exit PCKermit? [Y/N]: ");
Terminal.Read (ch);
IF CAP (ch) = 'Y' THEN
Terminal.Write ('Y');
StopReading; (* turn off the serial port *)
q := TRUE;
ELSE
Terminal.Write ('N');
END;
WriteLn;
END eXit;


PROCEDURE MainHelp;
(* help menu for main program loop *)
BEGIN
ClrScr;
WriteString (" P C K e r m i t H e l p M e n u"); WriteLn;
WriteLn;
WriteString ("set communications Options ............. O");
WriteLn;
WriteString ("Connect to host ........................ C");
WriteLn;
WriteString ("Directory .............................. D");
WriteLn;
WriteString ("Send a file ............................ S");
WriteLn;
WriteString ("Receive a file ......................... R");
WriteLn;
WriteString ("eXit ................................... X");
WriteLn; WriteLn;
WriteString ("To establish connection to Host:"); WriteLn;
WriteString (" -Use Connect Mode"); WriteLn;
WriteString (" -Dial Host (AT command set?)"); WriteLn;
WriteString (" -Log On to Host"); WriteLn;
WriteString (" -Issue Send (or Receive) command"); WriteLn;
WriteString (" -Return to main menu (^X)"); WriteLn;
WriteString (" -Issue Receive (or Send) command"); WriteLn;
WriteLn;
END MainHelp;


BEGIN (* module initialization *)
ClrScr;
baudRate := 1200;
stopBits := 1;
parityBit := TRUE;
evenParity := TRUE;
nbrOfBits := 7;
Initialize;
StartReading; (* turn on the serial port *)
echo := Off;
END Shell.



[LISTING SEVEN]

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

FROM InOut IMPORT
Write, WriteString, WriteInt, WriteHex, WriteLn;

FROM Terminal IMPORT
ReadString, Read, KeyPressed;

FROM Strings IMPORT
Length;

FROM BitByteOps IMPORT
ByteXor;

FROM FileSystem IMPORT
File;

FROM Files IMPORT
Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;

FROM DataLink IMPORT
FlushUART, SendPacket, ReceivePacket;

IMPORT ASCII;


CONST
myMAXL = 94;
myTIME = 10;
myNPAD = 0;
myPADC = 0C;
myEOL = 0C;
myQCTL = '#';
myQBIN = '&';
myCHKT = '1'; (* one character checksum *)
MAXtrys = 5;

TYPE
(* From Definition Module:
PacketType = ARRAY [1..100] OF CHAR;
*)
PathnameType = ARRAY [0..40] OF CHAR;

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 *)
sFname, rFname : PathnameType;
sP, rP : PacketType; (* packets sent/received *)
sSeq, rSeq : INTEGER; (* sequence numbers *)
PktNbr : INTEGER; (* actual packet number -- no repeats up to 32,000 *)


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 Aborted() : BOOLEAN;

VAR
ch : CHAR;

BEGIN
IF KeyPressed() THEN
Read (ch);
IF ch = 033C THEN (* Escape *)
RETURN TRUE;
END;
END;
RETURN FALSE;
END Aborted;


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
Write (p[i]);
END;
WriteLn;
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
WriteString ("Sent Packet #");
WriteInt (PktNbr, 5);
WriteString (" (ID: "); WriteHex (sSeq, 4);
WriteString ("h)");
WriteLn;

retrys := MAXtrys;
LOOP
IF Aborted() THEN
TellError (sSeq);
RETURN FALSE;
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
WriteString ("Resending Packet #");
WriteInt (PktNbr, 5);
WriteString (" (ID: "); WriteHex (sSeq, 4);
WriteString ("h)");
WriteLn;
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;
(* Sends a file after prompting for filename *)

VAR
ch : CHAR;
i : INTEGER;

BEGIN
WriteString ("Send: (filename?): ");
ReadString (sFname);
WriteLn;
IF Length (sFname) = 0 THEN
RETURN;
END;
IF Open (sF, sFname) # Done THEN
WriteString ("No such file: "); WriteString (sFname);
WriteLn;
RETURN;
END;
WriteString ("( to abort file transfer.)");
WriteLn; WriteLn;
FlushUART;
sSeq := 0; PktNbr := 0;
SendInit; (* my configuration information *)
IF NOT GetInitAck() THEN (* get your configuration information *)
WriteString ("Excessive Errors..."); WriteLn;
RETURN;
END;

SendFileName;
IF NOT GetAck() THEN
WriteString ("Excessive Errors..."); WriteLn;
RETURN;
END;

(* send file *)
i := 4;
LOOP
IF Aborted() THEN
TellError (sSeq);
RETURN;
END;
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
WriteString ("Excessive Errors..."); WriteLn;
RETURN;
END;
SendEOF;
IF NOT GetAck() THEN
WriteString ("Excessive Errors..."); WriteLn;
RETURN;
END;
SendEOT;
IF NOT GetAck() THEN
WriteString ("Excessive Errors..."); WriteLn;
RETURN;
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
WriteString ("Excessive Errors..."); WriteLn;
RETURN;
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 *)

IF CloseFile (sF, Input) # Done THEN
WriteString ("Problem closing source file..."); WriteLn;
END;
END Send;


PROCEDURE ReceiveInit() : BOOLEAN;
(* receive my initialization information from you *)

VAR
RecOK : BOOLEAN;
errors : INTEGER;

BEGIN
errors := 0;
LOOP
IF Aborted() THEN
TellError (rSeq);
RETURN FALSE;
END;
RecOK := (ReceivePacket (rP)) AND (rP[3] = 'S');
IF RecOK OR (errors = MAXtrys) THEN
EXIT;
ELSE
INC (errors);
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
WriteString ("Received Packet #");
WriteInt (PktNbr, 5);
WriteString (" (ID: "); WriteHex (rSeq, 4);
WriteString ("h)");
WriteLn;
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;
errors : INTEGER;

BEGIN
errors := 0;
LOOP
RecOK := ReceivePacket (rP) AND ((rP[3] = 'F') OR (rP[3] = 'B'));
IF errors = 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;
WriteString ("Filename = "); WriteString (rFname); WriteLn;
RETURN name;
ELSIF RecOK AND (rP[3] = 'B') THEN
RETURN eot;
ELSE
INC (errors);
SendNak;
END;
END;
END ReceiveHeader;


PROCEDURE SendNak;
BEGIN
WriteString ("Requesting Repeat of Packet #");
WriteInt (PktNbr, 5);
WriteString (" (ID: "); WriteHex (rSeq, 4);
WriteString ("h)");
WriteLn;
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
WriteString ("Duplicate Packet ");
ELSE
WriteString ("Received Packet #"); WriteInt (PktNbr, 5);
rSeq := (rSeq + 1) MOD 64;
INC (PktNbr);
END;
WriteString (" (ID: "); WriteHex (Seq, 4);
WriteString ("h)");
WriteLn;
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;
errors : INTEGER;

BEGIN
WriteString ("Ready to receive file(s)..."); WriteLn;
WriteString ("( to abort file transfer.)");
WriteLn; WriteLn;
FlushUART;
rSeq := 0; PktNbr := 0;
IF NOT ReceiveInit() THEN (* your configuration information *)
WriteString ("Excessive Errors..."); WriteLn;
RETURN;
END;
SendInitAck; (* send my configuration information *)
EOT := FALSE;
WHILE NOT EOT DO
IF Aborted() THEN
TellError (rSeq);
RETURN;
END;
CASE ReceiveHeader() OF
eot : EOT := TRUE; EOF := TRUE;
| name : IF Create (rF, rFname) # Done THEN
WriteString ("Unable to open file: ");
WriteString (rFname); WriteLn;
RETURN;
ELSE
PktNbr := 1;
EOF := FALSE;
END;
| fail : WriteString ("Excessive Errors..."); WriteLn;
RETURN;
END;
SendAck (rSeq); (* acknowledge for name or eot *)
WHILE NOT EOF DO
IF Aborted() THEN
TellError (rSeq);
RETURN;
END;
IF ReceivePacket (rP) THEN
Seq := UnChar (rP[2]);
Type := rP[3];
IF Type = 'Z' THEN
EOF := TRUE;
IF CloseFile (rF, Output) # Done THEN
WriteString ("Error closing file: ");
WriteString (rFname); WriteLn;
RETURN;
END;
SendAck (rSeq);
ELSIF Type = 'E' THEN
ShowError (rP);
RETURN;
ELSIF (Type = 'D') AND ((Seq + 1) MOD 64 = rSeq) THEN
(* discard duplicate packet, and Ack anyway *)
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
WriteString ("Error writing to file: ");
WriteString (rFname); WriteLn;
RETURN;
END;
errors := 0;
SendAck (rSeq);
ELSE
INC (errors);
IF errors = MAXtrys THEN
WriteString ("Excessive errors..."); WriteLn;
RETURN;
ELSE
SendNak;
END;
END;
ELSE
INC (errors);
IF errors = MAXtrys THEN
WriteString ("Excessive errors..."); WriteLn;
RETURN;
ELSE
SendNak;
END;
END;
END;
END;
END Receive;


BEGIN (* module initialization *)
yourEOL := ASCII.cr;
yourNPAD := 0;
yourPADC := 0C;
END PAD.



[LISTING EIGHT]


IMPLEMENTATION MODULE Files; (* File I/O for Kermit *)

FROM FileSystem IMPORT
File, Response, Delete, Lookup, Close, ReadNBytes, WriteNBytes;

FROM InOut IMPORT
Read, WriteString, WriteLn, Write;

FROM SYSTEM IMPORT
ADR, SIZE;


TYPE
buffer = ARRAY [1..512] OF CHAR;

VAR
inBuf, outBuf : buffer;
inP, outP : CARDINAL; (* buffer pointers *)
read, written : CARDINAL; (* number of bytes read or written *)
(* by ReadNBytes or WriteNBytes *)


PROCEDURE Open (VAR f : File; name : ARRAY OF CHAR) : Status;
(* opens an existing file for reading, returns status *)
BEGIN
Lookup (f, name, FALSE);
IF f.res = done THEN
inP := 0; read := 0;
RETURN Done;
ELSE
RETURN Error;
END;
END Open;


PROCEDURE Create (VAR f : File; name : ARRAY OF CHAR) : Status;
(* creates a new file for writing, returns status *)

VAR
ch : CHAR;

BEGIN
Lookup (f, name, FALSE); (* check to see if file exists *)
IF f.res = done THEN
Close (f);
WriteString ("File exists! Overwrite? (Y/N): ");
Read (ch); Write (ch); WriteLn;
IF CAP (ch) = 'Y' THEN
Delete (name, f);
Close (f);
ELSE
RETURN Error;
END;
END;
Lookup (f, name, TRUE);
IF f.res = done THEN
outP := 0;
RETURN Done;
ELSE
RETURN Error;
END;
END Create;


PROCEDURE CloseFile (VAR f : File; Which : FileType) : Status;
(* closes a file after reading or writing *)
BEGIN
written := outP;
IF (Which = Output) AND (outP > 0) THEN
WriteNBytes (f, ADR (outBuf), outP, written);
END;
Close (f);
IF (written = outP) AND (f.res = done) THEN
RETURN Done;
ELSE
RETURN Error;
END;
END CloseFile;


PROCEDURE Get (VAR f : File; VAR ch : CHAR) : Status;
(* Reads one character from the file, returns status *)
BEGIN
IF inP = read THEN
ReadNBytes (f, ADR (inBuf), SIZE (inBuf), read);
inP := 0;
END;
IF read = 0 THEN
RETURN EOF;
ELSE
INC (inP);
ch := inBuf[inP];
RETURN Done;
END;
END Get;


PROCEDURE Put (ch : CHAR);
(* Writes one character to the file buffer *)
BEGIN
INC (outP);
outBuf[outP] := ch;
END Put;


PROCEDURE DoWrite (VAR f : File) : Status;
(* Writes buffer to disk only if nearly full *)
BEGIN
IF outP < 400 THEN (* still room in buffer *)
RETURN Done;
ELSE
WriteNBytes (f, ADR (outBuf), outP, written);
IF (written = outP) AND (f.res = done) THEN
outP := 0;
RETURN Done;
ELSE
RETURN Error;
END;
END;
END DoWrite;

END Files.



[LISTING NINE]


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

FROM InOut IMPORT

WriteString, WriteLn;

FROM Delay IMPORT
Delay; (* delay is in milliseconds *)

FROM BitByteOps IMPORT
ByteAnd;

IMPORT RS232Int; (* for RS232Int.BusyRead, RS232Int.Write *)

FROM PAD IMPORT
PacketType, yourNPAD, yourPADC, yourEOL;

IMPORT ASCII;


CONST
MAXtime = 10000;
MAXsohtrys = 100;

VAR
ch : CHAR;
GotChar : BOOLEAN;


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
RS232Int.BusyRead (ch, GotChar);
UNTIL NOT GotChar;
END FlushUART;


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

VAR
i : INTEGER;
checksum : INTEGER;

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


PROCEDURE ReceivePacket (VAR r : PacketType) : BOOLEAN;
(* strips SOH and checksum -- return FALSE if timed out or bad checksum *)

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

BEGIN
sohtrys := MAXsohtrys;
REPEAT
time := MAXtime;
REPEAT
DEC (time);
RS232Int.BusyRead (ch, GotChar);
UNTIL GotChar OR (time = 0);
ch := CHAR (ByteAnd (ch, 177C)); (* mask off MSB *)
(* skip over up to MAXsohtrys padding characters, *)
(* but allow only MAXsohtrys/10 timeouts *)
IF GotChar THEN
DEC (sohtrys);
ELSE
DEC (sohtrys, 10);
END;
UNTIL (ch = ASCII.soh) OR (sohtrys <= 0);

IF ch = ASCII.soh THEN
(* receive rest of packet *)
time := MAXtime;
REPEAT
DEC (time);
RS232Int.BusyRead (ch, GotChar);
UNTIL GotChar OR (time = 0);
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
time := MAXtime;
REPEAT
DEC (time);
RS232Int.BusyRead (ch, GotChar);
UNTIL GotChar OR (time = 0);
ch := CHAR (ByteAnd (ch, 177C));
r[i] := ch; INC (i);
INC (checksum, (ORD (ch)));
UNTIL (i > len);
time := MAXtime;
REPEAT
DEC (time);
RS232Int.BusyRead (ch, GotChar);
UNTIL GotChar OR (time = 0); (* get checksum character *)
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!!! *)
WriteString ("Bad Checksum"); WriteLn;
RETURN FALSE;
END;
ELSE
WriteString ("No SOH"); WriteLn;
RETURN FALSE;
END;
END ReceivePacket;

END DataLink.