(* 12/14/83 - Time out on first packet added *)
(* 12/14/83 - MTS system calls silenced *)
(* 12/05/83 - Carriage control option implemented *)
(* 12/03/83 - Tape mode and IBM mode established *)
(* 11/21/83 - Program commented *)
(* 11/19/83 - History line begun *)
(* 11/16/83 - complete working version in place *)
 
PROGRAM kermit;
(*
KERMIT file transfer utility for the Michigan Terminal System (MTS).
Version 1.0 written by William S. Hall, Mathematical Reviews,
Ann Arbor, MI in PASCAL/VS.
 
For program usage and limitations see SJ1K:kermit.doc
*)
%page
    CONST
    (*
    Ordinal values of control characters.  Where values differ between
    the EBCDEC and ASCII control characters, then are so noted.
    *)
	NUL = 00; SOH  = 01; STX = 2; ETX = 03;
	EOT = 55;	(* A/E = 04/55 *)
	ENQ = 45;	(* A/E = 05/45 *)
	ACK = 46;	(* A/E = 06/46 *)
	BEL = 47;	(* A/E = 07/47 *)
	BS = 22;	(* A/E = 08/22 *)
	HT = 05;	(* A/E = 09/05 *)
	LF = 37;	(* A/E = 10/37 *)
	VT = 11;  FF = 12;  CR = 13;  SO = 14;
	SI = 15; DLE = 16; DC1 = 17; DC2 = 18;
	DC3 = 19;
	DC4 = 60;	(* A/E = 20/60 *)
	NAK = 61;	(* A/E = 21/61 *)
	SYN = 50;	(* A/E = 22/50 *)
	ETB = 38;	(* A/E = 23/38 *)
	CAN = 24;
	EM = 25;
	SUB = 63;	(* A/E = 26/63 *)
	ESC = 39;	(* A/E = 27/39 *)
	FS = 28;
	GS = 29;
	RS = 30;
	US = 31;
	SP = 64;	(* A/E = 32/64 *)
	DEL = 7;	(* A/E = 127/7 *)
 
    (* Other program constants needed in the program *)
	MAXPACK = 94;	(* Maximum packet size *)
	MAXTRY = 5;	(* Times to retry a packet *)
	MYQUOTE = '#';	(* Quote character I will use *)
	MYPAD = 0;	(* Number of padding characters I need *)
	MYPCHAR = NUL;	(* Ordinal value of padding character I need *)
	MYEOL = CR;	(* Ordinal value of end of line char I need *)
	MYTIME = 5;	(* Seconds after which I should be timed out *)
	NAMESIZE = 40;	(* Maximum size of file name *)
	MAXFILES = 20;	(* Maximum number of files to send *)
	SNDINIT_DLY = 8000000; (* Delay in microseconds before first packet *)
%page
    TYPE
    (* These types are used to call MTS procedures *)
	char255 = packed array[1..255] of char;
	halfword = packed -32768..32767;
    (* This type holds a packet being received or sent *)
	packet_type = packed array[1..MAXPACK] of char;
    (* This points to a packet *)
	packet_ptr = @packet_type;
    (* Timeout variable for system time-out call *)
	intpair = array[1..2] of integer;
 
    VAR
	date : alfa;		(* used for running date and time call *)
	time : alfa;
	delay : intpair;	(* used for calling twait procedure *)
	cc : boolean;		(* Carriage control char in column 1? *)
	ccinfo : char;		(* used to set value of cc from input *)
	col : integer;		(* Marks column position *)
	cmdstr : char255;	(* used to issue commands to MTS *)
	ascii : boolean;	(* ascii char set in use *)
	i : integer;		(* Utility integer *)
	size : integer; 	(* Size of present data *)
	n : integer;		(* Message number *)
	rpsiz : integer;	(* Maximum receive packet size *)
	spsiz : integer;	(* Maximum send packet size *)
	pad : integer;		(* How much padding to send *)
	timint : integer;	(* Timeout for foreign host on sends *)
	numtry : integer;	(* Times this packet tried *)
	oldtry : integer;	(* Times previous packet retried *)
	debug : boolean;	(* true means debugging *)
	state : char;		(* Present state of the automaton *)
	padchar : char; 	(* Padding character to send *)
	eol : char;		(* End of line character to send *)
	quote : char;		(* Quote character in incoming data *)
	recpkt : packet_ptr;	(* Receive packet buffer pointer *)
	packet : packet_ptr;	(* Send packet buffer pointer *)
	command : char; 	(* Command - receive or send *)
	filnam : array[1..MAXFILES] of string(NAMESIZE); (* holds file names *)
	nfiles : integer;	(* number of files to send *)
	numsent : integer;	(* number already send *)
	bugfil : text;		(* debug file *)
	sndfil : text;		(* file to be sent *)
	rcvfil : text;		(* file to be received *)
%page
    PROCEDURE cmdnoe(const cmd : char255; const len : halfword); fortran;
    (* Makes MTS calls *)
 
    PROCEDURE twait(const code : integer; const val : intpair); fortran;
    (* Executes delays *)
 
    PROCEDURE setsys;
    (*
    Set the terminal for file transfer so that no packets are wrapped
    and the terminal is not paged.  Also MTS must not echo characters
    during the transfer, and control characters, especially control A,
    must be allowed to pass unintercepted by the front end (Hermes).
    Finally, reader mode allows XON-XOFF flow control.
    *)
	BEGIN
	    cmdnoe('$control *msink* width=255', 26);
	    cmdnoe('$control *msink* outlen=255', 27);
	    cmdnoe('$control *msink* reader=on', 26);
	    cmdnoe('$control *msink* echo=off', 25);
	    cmdnoe('$control *msink* npc=off', 24);
	    cmdnoe('$control *msink* pagewait=off', 29);
	END; {setsys}
 
    PROCEDURE resetsys;
    (* Restore the user's system after completion of run *)
	BEGIN
	    cmdnoe('$control *msink* reset', 22);
	END; {resetsys}
 
    FUNCTION toupper(c : char) : char;
    (* Convert lower to upper case *)
	BEGIN
	    if ((c >= 'a') and (c <= 'i')) or ((c >= 'j') and (c <= 'r'))
		or ((c >= 's') and (c <= 'z')) then
		    BEGIN
			if ascii
			    then toupper := chr(ord(c) - 32)
			else
			    toupper := chr(ord(c) + 64)
		    END
	    else toupper := c;
	END;  {toupper}
 
    FUNCTION checksum(c : INTEGER) : INTEGER; (* checksum based on ASCII sum *)
    (*
    Compute a checksum in the range 0 to 63.  This is a Pascal version
    of the formula (sum + (sum & 192) div 64) & 63, where & is bitwise 'and'
    *)
	VAR
	    x : INTEGER;
	BEGIN
	    x := (c MOD 256) DIV 64;
	    x := x + c;
	    checksum := x MOD 64;
	END; {checksum}
%page
    FUNCTION tochar(ch : integer) : char;
    (*
    Converts an integer in the range 0 to 94 to a printing character.
    If ASCII is the underlying character set, this is trivial.	For
    EBCDEC, the internal representation of characters in Pascal/VS,
    a case statement is appropriate.  Note that three characters,
    namely, "^", "`", and "\" cannot be represented in quotes and
    chr(ordinal value) is used instead.  This seems to be a pecularity
    of the MTS operating system and not EBCDEC in general.
    *)
	BEGIN
	    if ascii then
		tochar := chr(ch + 32)
	    else case ch of
		 0 : tochar := ' ';  1 : tochar := '!';  2 : tochar := '"';
		 3 : tochar := '#';  4 : tochar := '$';  5 : tochar := '%';
		 6 : tochar := '&';  7 : tochar := ''''; 8 : tochar := '(';
		 9 : tochar := ')'; 10 : tochar := '*'; 11 : tochar := '+';
		12 : tochar := ','; 13 : tochar := '-'; 14 : tochar := '.';
		15 : tochar := '/'; 16 : tochar := '0'; 17 : tochar := '1';
		18 : tochar := '2'; 19 : tochar := '3'; 20 : tochar := '4';
		21 : tochar := '5'; 22 : tochar := '6'; 23 : tochar := '7';
		24 : tochar := '8'; 25 : tochar := '9'; 26 : tochar := ':';
		27 : tochar := ';'; 28 : tochar := '<'; 29 : tochar := '=';
		30 : tochar := '>'; 31 : tochar := '?'; 32 : tochar := '@';
		33 : tochar := 'A'; 34 : tochar := 'B'; 35 : tochar := 'C';
		36 : tochar := 'D'; 37 : tochar := 'E'; 38 : tochar := 'F';
		39 : tochar := 'G'; 40 : tochar := 'H'; 41 : tochar := 'I';
		42 : tochar := 'J'; 43 : tochar := 'K'; 44 : tochar := 'L';
		45 : tochar := 'M'; 46 : tochar := 'N'; 47 : tochar := 'O';
		48 : tochar := 'P'; 49 : tochar := 'Q'; 50 : tochar := 'R';
		51 : tochar := 'S'; 52 : tochar := 'T'; 53 : tochar := 'U';
		54 : tochar := 'V'; 55 : tochar := 'W'; 56 : tochar := 'X';
		57 : tochar := 'Y'; 58 : tochar := 'Z'; 59 : tochar := '[';
		60 : tochar := chr(186);
		61 : tochar := ']';
		62 : tochar := chr(170);
		63 : tochar := '_';
		64 : tochar := chr(154);
		65 : tochar := 'a';
		66 : tochar := 'b'; 67 : tochar := 'c'; 68 : tochar := 'd';
		69 : tochar := 'e'; 70 : tochar := 'f'; 71 : tochar := 'g';
		72 : tochar := 'h'; 73 : tochar := 'i'; 74 : tochar := 'j';
		75 : tochar := 'k'; 76 : tochar := 'l'; 77 : tochar := 'm';
		78 : tochar := 'n'; 79 : tochar := 'o'; 80 : tochar := 'p';
		81 : tochar := 'q'; 82 : tochar := 'r'; 83 : tochar := 's';
		84 : tochar := 't'; 85 : tochar := 'u'; 86 : tochar := 'v';
		87 : tochar := 'w'; 88 : tochar := 'x'; 89 : tochar := 'y';
		90 : tochar := 'z'; 91 : tochar := '{'; 92 : tochar := '|';
		93 : tochar := '}'; 94 : tochar := '~';
		otherwise
		    if debug then writeln(bugfil, 'tochar error');
	    END; {case}
	END; {tochar}
%page
    FUNCTION unchar(ch : char) : integer; (* Undoes tochar *)
    (*
    Converts a printing character to an integer in the range 0-94.
    This procedure undoes the action of "tochar".
    *)
	BEGIN
	    if ascii then
		unchar := ord(ch) - 32
	    else case ch of
		' ' : unchar := 0;  '!' : unchar := 1;	'"' : unchar := 2;
		'#' : unchar := 3;  '$' : unchar := 4;	 '%' : unchar := 5;
		'&' : unchar := 6;  '''': unchar := 7;	'(' : unchar := 8;
		')' : unchar := 9;  '*' : unchar := 10; '+' : unchar := 11;
		',' : unchar := 12; '-' : unchar := 13; '.' : unchar := 14;
		'/' : unchar := 15; '0' : unchar := 16; '1' : unchar := 17;
		'2' : unchar := 18; '3' : unchar := 19; '4' : unchar := 20;
		'5' : unchar := 21; '6' : unchar := 22; '7' : unchar := 23;
		'8' : unchar := 24; '9' : unchar := 25; ':' : unchar := 26;
		';' : unchar := 27; '<' : unchar := 28; '=' : unchar := 29;
		'>' : unchar := 30; '?' : unchar := 31; '@' : unchar := 32;
		'A' : unchar := 33; 'B' : unchar := 34; 'C' : unchar := 35;
		'D' : unchar := 36; 'E' : unchar := 37; 'F' : unchar := 38;
		'G' : unchar := 39; 'H' : unchar := 40; 'I' : unchar := 41;
		'J' : unchar := 42; 'K' : unchar := 43; 'L' : unchar := 44;
		'M' : unchar := 45; 'N' : unchar := 46; 'O' : unchar := 47;
		'P' : unchar := 48; 'Q' : unchar := 49; 'R' : unchar := 50;
		'S' : unchar := 51; 'T' : unchar := 52; 'U' : unchar := 53;
		'V' : unchar := 54; 'W' : unchar := 55; 'X' : unchar := 56;
		'Y' : unchar := 57; 'Z' : unchar := 58; '[' : unchar := 59;
		chr(186) : unchar := 60;
		']' : unchar := 61;
		chr(170) : unchar := 62;
		'_' : unchar := 63;
		chr(154) : unchar := 64;
		'a' : unchar := 65;
		'b' : unchar := 66; 'c' : unchar := 67; 'd' : unchar := 68;
		'e' : unchar := 69; 'f' : unchar := 70; 'g' : unchar := 71;
		'h' : unchar := 72; 'i' : unchar := 73; 'j' : unchar := 74;
		'k' : unchar := 75; 'l' : unchar := 76; 'm' : unchar := 77;
		'n' : unchar := 78; 'o' : unchar := 79; 'p' : unchar := 80;
		'q' : unchar := 81; 'r' : unchar := 82; 's' : unchar := 83;
		't' : unchar := 84; 'u' : unchar := 85; 'v' : unchar := 86;
		'w' : unchar := 87; 'x' : unchar := 88; 'y' : unchar := 89;
		'z' : unchar := 90; '{' : unchar := 91; '|' : unchar := 92;
		'}' : unchar := 93; '~' : unchar := 94;
		otherwise
		    if debug then writeln(bugfil, 'unchar error');
	    END; {case}
	END; {unchar}
%page
    FUNCTION ctl(ch : char) : char;
    (*
    Changes the printing characters shown below to control characters.
    Used to unquote a quoted control character in a packet.
    *)
	BEGIN
	    if ascii then
		ctl := chr(ord(ch) - 64)
	    else case ch of
		'@' : ctl := chr(NUL); 'A' : ctl := chr(SOH);
		'B' : ctl := chr(STX); 'C' : ctl := chr(ETX);
		'D' : ctl := chr(EOT); 'E' : ctl := chr(ENQ);
		'F' : ctl := chr(ACK); 'G' : ctl := chr(BEL);
		'H' : ctl := chr(BS);  'I' : ctl := chr(HT);
		'J' : ctl := chr(LF);  'K' : ctl := chr(VT);
		'L' : ctl := chr(FF);  'M' : ctl := chr(CR);
		'N' : ctl := chr(SO);  'O' : ctl := chr(SI);
		'P' : ctl := chr(DLE); 'Q' : ctl := chr(DC1);
		'R' : ctl := chr(DC2); 'S' : ctl := chr(DC3);
		'T' : ctl := chr(DC4); 'U' : ctl := chr(NAK);
		'V' : ctl := chr(SYN); 'W' : ctl := chr(ETB);
		'X' : ctl := chr(CAN); 'Y' : ctl := chr(EM);
		'Z' : ctl := chr(SUB); '[' : ctl := chr(ESC);
		chr(186) : ctl := chr(FS);
		']' : ctl := chr(GS);
		chr(170) : ctl := chr(RS);
		'_' : ctl := chr(US);
		'?' : ctl := chr(DEL);
		otherwise
		    if debug then writeln(bugfil, 'ctl error');
	    END; {case}
	END; {ctl}
%page
    FUNCTION unctl(ch : char) : char;
    (* Changes a control character to its corresponding printing form *)
	VAR
	    i : integer;
	BEGIN
	    i := ord(ch);
	    if ascii then
		unctl := chr(i + 64)
	    else case i of
		NUL : unctl := '@'; SOH : unctl := 'A';
		STX : unctl := 'B'; ETX : unctl := 'C';
		EOT : unctl := 'D'; ENQ : unctl := 'E';
		ACK : unctl := 'F'; BEL : unctl := 'G';
		 BS : unctl := 'H';  HT : unctl := 'I';
		 LF : unctl := 'J';  VT : unctl := 'K';
		 FF : unctl := 'L';  CR : unctl := 'M';
		 SO : unctl := 'N';  SI : unctl := 'O';
		DLE : unctl := 'P'; DC1 : unctl := 'Q';
		DC2 : unctl := 'R'; DC3 : unctl := 'S';
		DC4 : unctl := 'T'; NAK : unctl := 'U';
		SYN : unctl := 'V'; ETB : unctl := 'W';
		CAN : unctl := 'X';  EM : unctl := 'Y';
		SUB : unctl := 'Z'; ESC : unctl := '[';
		 FS : unctl := chr(186);
		 GS : unctl := ']';
		 RS : unctl := chr(170);
		 US : unctl := '_';
		DEL : unctl := '?';
		otherwise
		    if debug then writeln(bugfil, 'unctl error');
	    END; {case}
	END; {unctl}
%page
    FUNCTION aord(ch : char) : integer;
    (* Convert a character to its ASCII ordinal value *)
	BEGIN
	    if ascii then aord := ord(ch)
	    else aord := unchar(ch) + 32;
	END; {aord}
 
    FUNCTION writeopn(nampkt : packet_ptr; len : integer) : boolean;
    (*
    Open a file for writing during receive mode.  The filename itself
    is obtained from the sending Kermit in a file name packet.	The
    name is extracted and concatenated to dynamically create and open
    it.  Pascal/VS does not presently return error codes, but by
    declaring the function as boolean, this feature can be readily
    implemented when return codes become available.  Use of column
    1 for carriage control is an option.
    *)
	VAR
	    filnam : string(NAMESIZE);
	    crname : string(NAMESIZE + 20);
	BEGIN
	    filnam := substr(str(nampkt@), 1, len);
	    crname := '$create '||filnam;
	    cmdnoe(crname, length(crname));
	    if debug then writeln(bugfil, 'Opening ', filnam);
	    if cc then
		rewrite(rcvfil, 'FILE='||filnam|| ' MAXLEN=255 ')
	    else
		rewrite(rcvfil, 'FILE='||filnam|| ' MAXLEN=255 NOCC');
	    col := 1;
	    writeopn := true;
	END; {writeopn}
 
    FUNCTION getnxt : boolean;
    (*
    Gen next file for reading when in send mode.  No error codes are
    returned by Pascal/VS at present, but the function returns a
    boolean value, allowing implementation of such when available.
    *)
	BEGIN
	    if debug then writeln(bugfil, 'Opening ', filnam[numsent]);
	    reset(sndfil, 'FILE='||filnam[numsent]||' MAXLEN=255');
	    col := 1;
	    getnxt := true;
	END; {getnxt}
%page
    PROCEDURE rpar(data : packet_ptr);
    (* Get the other side's sent-init packet.  The time-out is N/A *)
	BEGIN
	    spsiz := unchar(data@[1]);	(* Maximum send packet size *)
	    timint := unchar(data@[2]); (* When I should time out *)
	    pad := unchar(data@[3]);	(* Number of pads to send *)
	    padchar := ctl(data@[4]);	(* padding char to send *)
	    eol := chr(unchar(data@[5])); (* end-of-line char to send *)
	    quote := data@[6];		(* incoming data quote char *)
	    if debug then		(* write this to trace file *)
		writeln(bugfil, 'sendinit data from other side - ',
			spsiz:3, timint:3, pad:3, ord(padchar):3,
			ord(eol):3, quote);
	END; {rpar}
 
    PROCEDURE spar(data : packet_ptr);
    (* Fill data array with my send-init parameters *)
	BEGIN
	    data@[1] := tochar(MAXPACK);	(* my max packet size *)
	    data@[2] := tochar(MYTIME); 	(* when I should be timed out *)
	    data@[3] := tochar(MYPAD);		(* how much padding I need *)
	    data@[4] := unctl(chr(MYPCHAR));	(* my pad char *)
	    data@[5] := tochar(MYEOL);		(* my end of line *)
	    data@[6] := MYQUOTE;		(* quote char I send *)
	END; {spar}
%page
    FUNCTION bufill(bufptr : packet_ptr) : integer;
    (*
    Get a buffer full of data from the file that is being sent.
    Control characters are quoted (preceded by a '#').
    *)
    VAR
	i : integer;		(* loop index *)
	t : char;		(* utility character *)
    BEGIN
	i := 1;
	while (not eof(sndfil)) and ( i < spsiz - 8) do
	(* spsiz - 8 keeps the buffer from overflowing *)
	    BEGIN
		if eoln(sndfil) then	(* end of line.  Quote CR and LF *)
		    BEGIN
(* quote the char *)	bufptr@[i] := quote;
(* uncontrollify it *)	bufptr@[i + 1] := unctl(chr(CR));
(* do the same for *)	bufptr@[i + 2] := quote;
(* the line feed *)	bufptr@[i + 3] := unctl(chr(LF));
(* bump loop ctr *)	i := i + 4;
			readln(sndfil); 	(* reset file pointer *)
			col := 1;		(* reset column position *)
		    END {if}
		else
		    BEGIN
			read(sndfil,t); 	(* get the next char *)
			if ((col = 1) and cc) then
			    BEGIN
				if t = '1' then    (* ignore unless FF *)
				    BEGIN
(* quote the form feed *)		 bufptr@[i] := quote;
(* put char in buffer *)		 bufptr@[i + 1] := unctl(chr(FF));
(* bump counter *)			 i := i + 2;
				     END
			    END {col = 1}
(* control char or *)	else if (ord(t) < SP) or (t = chr(DEL))
				 or (t = quote) then
(* quote? *)		    BEGIN
(* yes, so quote it *)		bufptr@[i] := quote;
(* uncontrollify it *)		if t <> quote then t := unctl(t);
(* put char in buffer *)	bufptr@[i + 1] := t;
(* bump counter *)		i := i + 2;
			    END
			else
			    BEGIN
				bufptr@[i] := t;  (* put char in buffer *)
				i := i + 1;	  (* bump counter *)
			    END;
		   col := col + 1;		  (* advance column counter *)
		   END; {else}
	     END; {while}
	     bufill := i - 1;			  (* return count *)
    END; {bufill}
%page
    PROCEDURE bufemp(buffer : packet_ptr; len : integer);
    (* Get data from incoming packet into a file *)
	VAR
	    i : integer;		(* counter *)
	    t : char;			(* utility character *)
	BEGIN
	    i := 1;
	    while i <= len do		(* loop thru character field *)
		BEGIN
		    t := buffer@[i];	(* get character *)
		    if t = MYQUOTE then (* next char must be unquoted *)
			BEGIN
			    i := i + 1; 	(* bump counter *)
			    t := buffer@[i];	(* get quoted char *)
			    case t of
(* it was a real quote *)	MYQUOTE : write(rcvfil, t);
(* CR, so assume newline *)	'M' : begin
					  writeln(rcvfil);
(* reset column marker *)		  col := 1;
				      end;
(* LF, don't pass *)		'J' : ;
(* FF, so make new page *)	'L' : begin
					  page(rcvfil);
					  col := col + 1;
				      end;
(* expand the tabs *)		'I' : repeat
(* assume stops at 1, 9, 17, etc. *)	  write(rcvfil, ' ');
					  col := col + 1;
				      until (col mod 8 = 1);
				otherwise
(* make a control character *)	    begin
					write(rcvfil, ctl(t));
(* increment column marker *)		col := col + 1;
				    end;
			    END; {case}
			END {if}
		    else
			begin
			    write(rcvfil, t);	(* put character into file *)
			    col := col + 1;	(* increment column marker *)
			end;
		    i := i + 1;
		END; {while}
	END; {bufemp}
%page
    FUNCTION rpack(var len, num : integer; data : packet_ptr) : char;
    (* Read a packet being sent.  Compute check sum, return packet type *)
	LABEL 10;	(* Heavens! a GOTO - for resynchronization *)
	VAR
	    i, chksum : integer;	(* counter, check sum *)
	    done : boolean;		(* packet read if true *)
	    t, class : char;		(* utility char, packet type *)
	BEGIN
	    if debug then writeln(bugfil, 'rpack');	(* debug, trace file *)
	    while t <> chr(SOH) do read(t);	(* look for synch char SOH *)
	    if debug then write(bugfil, t);	(* save in debugging file *)
	    done := false;			(* not yet done *)
	10: while not done do
		BEGIN
		    read(t);				(* get char *)
		    if debug then write(bugfil, t);	(* save in trace file *)
		    if t = chr(SOH) then goto 10;  (* if synch, start again *)
		    chksum := aord(t);		(* accumulate check sum *)
		    len := unchar(t) - 3;	(* get length of packet *)
 
		    read(t);				(* get char *)
		    if debug then write(bugfil, t);	(* save in trace file *)
		    if t = chr(SOH) then goto 10;	(* resynchronize *)
		    chksum := chksum + aord(t); (* accumulate check sum *)
		    num := unchar(t);		(* get packet number *)
 
		    read(t);				(* get char *)
		    if debug then write(bugfil, t);	(* save in trace file *)
		    if t = chr(SOH) then goto 10;	(* resynchronize *)
		    chksum := chksum + aord(t); 	(* accumulate sum *)
		    class := t; 			(* get packet type *)
 
		    for i := 1 to len do	(* get the actual data *)
			BEGIN
(* get char *)		    read(t);
(* save in trace file *)    if debug then write(bugfil, t);
(* resynchronize *)	    if t = chr(SOH) then goto 10;
(* accumulate check sum *)  chksum := chksum + aord(t);
(* store data *)	    data@[i] := t;
			END;
 
		    read(t);			(* get sender's check sum *)
(* resynchronize *) if t = chr(SOH) then goto 10;
(* save in trace *) if debug then write(bugfil, t);
		    done := true;		(* end of packet *)
		END; {while}
	    if t = tochar(checksum(chksum)) then rpack := class else
		rpack := 'E';	(* compare check sums, return 'E' if bad *)
	    if debug then writeln(bugfil);	(* flush line to trace file *)
	END; {rpack}
%page
    PROCEDURE spack(class : char; num, len : integer; data : packet_ptr);
    (* Send a packet to the other side *)
	TYPE
	    buffer = packed array[1..100] of char;
	VAR
	    i : integer;	(* counter *)
	    chksum : integer;	(* packet checksum *)
	    bufp : @buffer;	(* pointer to buffer *)
	BEGIN
	    if debug then writeln(bugfil, 'spack');	(* save in trace *)
	    if pad > 0 then			(* send padding if needed *)
		for i := 1 to pad do write(padchar);
	    new(bufp);				(* make space *)
	    bufp@[1] := chr(SOH);		(* synch character *)
	    bufp@[2] := tochar(len + 3);   (* char representation of length *)
	    chksum := aord(bufp@[2]);	(* char representation of check sum *)
	    bufp@[3] := tochar(num); (* char representation of packet number *)
	    chksum := chksum + aord(bufp@[3]);	(* accumulate check sum *)
	    bufp@[4] := class;			(* packet type *)
	    chksum := chksum + aord(class);	(* accumulate check sum *)
	    for i := 1 to len do	(* accumulate data and check sum *)
		BEGIN
		    bufp@[4 + i] := data@[i];
		    chksum := chksum + aord(data@[i]);
		END;
	    bufp@[len + 4 + 1] := tochar(checksum(chksum));
				(* char representation of check sum *)
	    bufp@[len + 4 + 2] := eol;	(* end of line wanted by other end *)
	    for i := 1 to (len+4+1) do write(bufp@[i]);
				(* send it out to other side *)
	    writeln(bufp@[len+4+2]);  (* IMPORTANT! Must flush output in MTS *)
	    if debug then	(* save the packet in the trace file *)
		BEGIN
		    for i := 1 to (len+4+2) do write(bugfil, bufp@[i]);
		    writeln(bugfil);	(* flush to file *)
		END;
	END; {spack}
%page
    FUNCTION recsw : boolean;
    (* State table switcher for receiving files *)
	VAR
	    done : boolean;	(* no more files to receive if true *)
 
	FUNCTION rinit : char;
	(* Receive initialization from sender *)
	    VAR
		len, num : integer;	(* packet length, number *)
	    BEGIN
		if debug then writeln(bugfil, 'rinit');
		if numtry > MAXTRY then (* too many tries, so abort *)
		    rinit := 'A'
		else
		    BEGIN
(* bump try count *)	numtry := numtry + 1;
(* get a packet *)	case rpack(len, num, recpkt) of
(* got a send-init *)	    'S' : BEGIN
(* retrieve parameters from sender *) rpar(recpkt);
(* fill up packet with my info *)     spar(packet);
(* ACK with my packet *)	      spack('Y', n, 6, packet);
(* save old try count *)	      oldtry := numtry;
(* start a new counter *)	      numtry := 0;
(* bump count, mod 64 *)	      n := (n + 1) mod 64;
(* return file-send state *)	      rinit := 'F';
				  END; {S}
(* didn't get packet *)      'E' : rinit := state;	(* keep waiting *)
(* some other type, abort *) otherwise
				  rinit := 'A';
			END; {case}
		    END; {else}
	    END; {rinit}
%page
	FUNCTION rfile : char;
	(* Receive file name *)
	    VAR
		num, len : integer;	(* packet number, length *)
		k : integer;	 (* utility integer *)
	    BEGIN
		if debug then writeln(bugfil, 'rfile');
		if numtry > MAXTRY then (* abort if too many tries *)
		    rfile := 'A'
		else
		    BEGIN
(* bump count *)	numtry := numtry + 1;
(* get a packet *)	case rpack(len, num, recpkt) of
(* send-init, maybe ACK *)  'S' : BEGIN
(* has been lost *)		      if oldtry > MAXTRY then
(* if too many tries, abort *)		  rfile := 'A'
				      else
					  BEGIN
(* bump oldtry count as well *) 	      oldtry := oldtry + 1;
(* previous packet mod 64 ? *)		      k := n - 1;
					      if k < 0 then k := 63;
(* yes, so ACK it again *)		      if num = k then
						  BEGIN
(* send our send-init packet *) 		      spar(packet);
						      spack('Y', num,
							    6, packet);
(* reset try counter *) 			      numtry := 0;
(* stay in this state *)			      rfile := state;
						  END
					      else
(* not previous packet, abort *)		  rfile := 'A';
					  END; {else}
				  END; {S}
(* end-of-file *)	    'Z' : BEGIN
				      if oldtry > MAXTRY then
					  rfile := 'A'
				      else
					  BEGIN
					      oldtry := oldtry + 1;
(* previous packet, mod 64 ? *) 	      k := n - 1;
					      if k < 0 then k := 63;
(* yes, so ACK it again *)		      if num = k then
						  BEGIN
						      spack('Y', num, 0,
							    packet);
						      numtry := 0;
(* stay in this state *)			      rfile := state;
						  END
					      else
(* not previous packet, abort *)		  rfile := 'A';
					  END
				  END; {Z}
(* file-header *)	    'F' : BEGIN
(* what we really want so the *)      if num <> n then
(* packet number must be correct *)	  rfile := 'A'
				      else
					  BEGIN
(* try to open a new file *)		      if not writeopn(recpkt, len) then
						  rfile := 'A'
					      else
(* if OK then *)				  BEGIN
(* ACK the file header *)			      spack('Y', n, 0, packet);
(* reset counters *)				      oldtry := numtry;
						      numtry := 0;
(* bump packet number mod 64 *) 		      n := (n + 1) mod 64;
(* switch to data packet *)			      rfile := 'D';
						  END;
					  END;
				  END; {F}
(* break transmission *)    'B' : BEGIN
(* need correct packet number *)      if num <> n then
					  rfile := 'A'
				      else
					  BEGIN
(* say OK *)				      spack('Y', n, 0, packet);
(* switch to complete state *)		      rfile := 'C';
					  END;
				  END; {B}
(* souldn't get packet *)   'E' : rfile := state;	(* keep trying *)
(* something else, abort *)  otherwise
				   rfile := 'A';
			END; {case}
		    END;
	    END; {rfile}
 
	FUNCTION rdata : char;
	(* Receive data *)
	    VAR
		num, len : integer;		(* packet number, length *)
		k : integer;	 (* utility integer *)
	    BEGIN
		if debug then writeln(bugfil, 'rdata');
		if numtry > MAXTRY then 	(* abort if too many tries *)
		    rdata := 'A'
		else
		    BEGIN
			numtry := numtry + 1;	(* bump try counter *)
(* get packet *)	case rpack(len, num, recpkt) of
(* got a data packet *)     'D' : BEGIN
(* looks like wrong number *)	      if num <> n then
					  BEGIN
(* if too many tries, then quit *)	      if oldtry > MAXTRY then
						  rdata := 'A'
					      else
						  BEGIN
(* bump oldtry counter *)			      oldtry := oldtry + 1;
(* see if we have previous packet again *)	      k := n - 1;
						      if k < 0 then k := 63;
(* yes, got previous one *)			      if num = k then
							  BEGIN
(* re-ACK the packet *) 				      spack('Y', num,
								    0, packet);
(* reset try counter *) 				      numtry := 0;
(* stay in D, don't write out data *)			      rdata := state;
							  END
						      else
(* Sorry, wrong number *)				  rdata := 'A';
						  END;
					  END; { num <> n }
(* write the packet to file *)	      bufemp(recpkt, len);
(* acknowledge the packet *)	      spack('Y', n, 0, packet);
(* reset the counters *)	      oldtry := numtry;
				      numtry := 0;
(* count packets, mod 64 *)	      n := (n + 1) mod 64;
(* stay in this state *)	      rdata := 'D';
				  END; {D}
(* got a file header *)    'F' :  BEGIN
(* too many, so quit *) 	      if oldtry > MAXTRY then
					  rdata := 'A'
				      else
					  BEGIN
(* bump try counter *)			      oldtry := oldtry + 1;
(* see if previous packet *)		      k := n - 1;
					      if k < 0 then k := 63;
(* yes, so ACK it again *)		      if num = k then
						  BEGIN
						      spack('Y', num, 0,
							    packet);
						      numtry := 0;
(* stay in data state *)			      rdata := state;
						  END
					      else
(* not previous packet so abort *)		  rdata := 'A';
					  END;
				  END; {Z}
			    'Z' : BEGIN
(* must have right packet *)	      if num <> n then
					  rdata := 'A'
				      else
					  BEGIN
(* OK, so ACK it *)			      spack('Y', n, 0, packet);
(* close the file *)			      close(rcvfil);
(* bump packet counter *)		      n := (n + 1) mod 64;
(* go back to receive file state *)	      rdata := 'F';
					  END;
				  END;
(* nothing, keep waiting *) 'E' : rdata := state;
(* some other type, *)	    otherwise
(* so abort *)			  rdata := 'A';
			END; {case}
		  END;
	    END; {rdata}
 
	BEGIN {recsw}
	    done := false;	(* initialize *)
	    state := 'R';	(* always start in receive state *)
	    n := 0;		(* initialize message number *)
	    numtry := 0;	(* no tries yet *)
	    while not done do	(* do until done *)
	       case state of
		   'D' : state := rdata;	(* data receive state *)
		   'F' : state := rfile;	(* file receive state *)
		   'R' : state := rinit;	(* send initiate state *)
		   'C' : BEGIN			(* completed state *)
			     recsw := true;
			     done := true;
			 END;
		   'A' : BEGIN			(* abort state *)
			     recsw := false;
			     done := true;
			 END;
	       END; {case}
	END; {recsw}
%page
    FUNCTION sendsw : boolean;
    (* State table switcher for sending files *)
	VAR
	    done : boolean;	(* indicates that sending is finished *)
 
	FUNCTION sinit : char;
	(* Send my parameters and get other side's back *)
	    VAR
		num, len : integer;		(* packet number, length *)
	    BEGIN {function sinit}
		if debug then writeln(bugfil, 'sinit');
		if numtry > MAXTRY then sinit := 'A'	(* too many tries *)
		else
		    BEGIN
			numtry := numtry + 1;	(* bump try counter *)
			spar(packet);		(* fill up with init info *)
			spack('S', n, 6, packet);	(* send it out *)
			case rpack(len, num, recpkt) of (* get reply *)
(* NAK packet *)	    'N', 'E' : sinit := state;	(* just stay in state *)
(* ACK packet *)	    'Y' : BEGIN
(* wrong ACK, stay in state *)	      if n <> num then
					  sinit := state
				      else
					  BEGIN
(* get other side's init info *)	      rpar(recpkt);
(* check and set defaults *)		      if eol = chr(NUL)
						  then eol := chr(CR);
					      if quote = chr(NUL)
						  then quote := MYQUOTE;
(* reset try counter *) 		      numtry := 0;
(* bump packet count *) 		      n := (n + 1) mod 64;
(* open file to be sent *)		      if getnxt then
(* if open OK go to next state *)		  sinit := 'F'
(* no good, so give up *)		      else sinit := 'A';
					  END; {else}
				  END; {'Y'}
(* unknown, abort *)	    otherwise
				sinit := 'A';
		       END; {case}
		END; {else}
	    END; {sinit}
%page
	FUNCTION sfile : char;
	(* Send file name *)
	    VAR
		num, len, l : integer;	(* packet number, len, stringlength *)
		c : char;		(* utility character *)
	    BEGIN
		if debug then writeln(bugfil, 'sfile');
		if numtry > MAXTRY	(* too many tries, give up *)
		    then sfile := 'A'
		else
		    BEGIN
			numtry := numtry + 1;	(* bump try counter *)
			len := 0;	(* set packet length to zero *)
			l := length(filnam[numsent]);	(* length of filename *)
			while (len < l) and (len < NAMESIZE) do
			      BEGIN
				  len := len + 1;	(* accumulate length *)
(* stash away the name itself *)  packet@[len] :=
(* in upper case *)		       toupper(filnam[numsent][len]);
			      END;
(* send it out *)	spack('F', n, len, packet);
(* get reply *) 	c := rpack(len, num, recpkt);
			case c of
(* NAK or ACK *)	     'N', 'Y' : BEGIN
					    if c = 'N' then
(* as before, stay in this state *)		BEGIN
(* unless NAK for next packet *)		    num := num - 1;
(* which is like an ACK for this packet *)	    if num < 0 then num := 63;
						END;
(* wrong count so stay in this state *)     if n <> num then sfile := state
					    else
						BEGIN
(* reset counters *)				    numtry := 0;
(* bump packet count *) 			    n := (n + 1) mod 64;
(* get first data from file *)			    size := bufill(packet);
(* switch to data state *)			    sfile := 'D';
						END;
					END;
(* receive failure *)	     'E' : sfile := state;	(* just stay here *)
			     otherwise
(* unknown, abort *)		 sfile := 'A';
			END; {case}
		    END; {else}
	    END;  {sinit}
%page
	FUNCTION sdata : char;
	    VAR
		    num, len : integer; 	(* packet number, length *)
		    c : char;			(* utility character *)
	    BEGIN
		if debug then writeln(bugfil, 'sdata');
		if numtry > MAXTRY then sdata := 'A'	(* abort if too many *)
		else
		    BEGIN
			numtry := numtry + 1;		(* bump try counter *)
			spack('D', n, size, packet);	(* send a data packet *)
			c := rpack(len, num, recpkt);	(* get the reply *)
			case c of
			    'N', 'Y' : BEGIN		(* NAK or ACK *)
(* respond to NAK *)			   if c = 'N' then
					       BEGIN
						   num := num - 1;
						   if num < 0 then num := 63;
					       END;
(* just stay in this state *)		   if n <> num then sdata := state
(* unless NAK is for next packet *)	   else
(* which is like an ACK for this one *)        BEGIN
(* reset try counter *) 			    numtry := 0;
(* bump packet count *) 			    n := (n + 1) mod 64;
						    if not eof(sndfil) then
							BEGIN
(* get data from file if not at end *)			    size :=
							       bufill(packet);
(* stay in data state *)				       sdata := 'D';
							   END
							else
(* EOF, so switch to that state *)			   sdata := 'Z';
					       END;
				   END;
(* receive failure *)	     'E' : sdata := state;	(* stay in state *)
			     otherwise
(* anything else, abort *)	 sdata := 'A';
			END; {case}
		    END; {else}
	    END;  {sdata}
%page
	FUNCTION seof : char;
	(* Send enf-of-file *)
	    VAR
		num, len : integer;	(* packet number, length *)
		c : char;		(* utility char *)
	    BEGIN
		if debug then writeln(bugfil, 'seof');
		if numtry > MAXTRY then 	(* too many, quit *)
		    seof := 'A'
		else
		    BEGIN
			numtry := numtry + 1;	(* bump counter *)
			spack('Z', n, 0, packet);	(* send Z packet *)
			c := rpack(len, num, recpkt);	(* get reply *)
			case c of
(* ACK or NAK *)	     'N', 'Y' : BEGIN
(* NAK, fail unless for *)		    if c = 'N' then
(* previous packet *)				BEGIN
(* then fall thru *)				    num := num - 1;
						    if num < 0 then num := 63;
						END;
(* wrong, so stay in state *)		    if n <> num then seof := state
					    else
						BEGIN
(* reset counter *)				    numtry := 0;
(* increment count *)				    n := (n + 1) mod 64;
						    if debug then
							writeln(bugfil,
							'closing - ',
							 filnam[numsent]);
(* close the file *)				    close(sndfil);
(* increment number of files sent *)		    numsent := numsent + 1;
(* get new one if more to go *) 		    if numsent < nfiles then
							BEGIN
(* and go back to filename state *)			    if getnxt then
								seof := 'F'
							    else
(* unless failure in file open *)				seof := 'B'
							END
(* no more files, so set break state *) 	    else seof := 'B';
					      END; {else}
				   END; {N, Y}
(* error, stay in state *)   'E' : seof := state;
(* unknown, abort *)	     otherwise
				 seof := 'A';
			END; {case}
		    END; { else }
	    END; {seof}
%page
	FUNCTION sbreak : char;
	(* send a break *)
	    VAR
		num, len : integer;	(* packet number, length *)
		c : char;		(* utility char *)
	    BEGIN
		if debug then writeln(bugfil, 'sbreak');
		if numtry > MAXTRY then
		    sbreak := 'A'   (* abort if too many *)
		else
		    BEGIN
(* bump counter *)	numtry := numtry + 1;
(* send a break *)	spack('B', n, 0, packet);
(* look at reply *)	c := rpack(len, num, recpkt);
			case c of
(* see if ACK for this *)   'N', 'Y' : BEGIN
(* packet or NAK for previous *)	   if c = 'N' then
					       BEGIN
						   num := num - 1;
						   if num < 0 then num := 63;
					       END;
(* if wrong, then stay in state *)	   if n <> num then sbreak := state
					   else
					       BEGIN
(* reset counter *)				   numtry := 0;
(* bump packet count *) 			   n := (n + 1) mod 64;
(* switch to complete state *)			   sbreak := 'C';
					       END;
				       END;
(* receive failure *)	     'E' : sbreak := state;	(* stay in state *)
			     otherwise
(* unknown, abort *)		 sbreak := 'A';
			END; {case}
		    END; { else }
	    END; {sbreak}
%page
	BEGIN {sendsw}
	    done := false;		(* not done yet *)
	    state := 'S';		(* send initiate is the start state *)
	    n := 0;			(* initialize message number *)
	    numtry := 0;		(* no tries yet *)
	    while not done do
		case state of
		    'D' : state := sdata;	(* data send state *)
		    'F' : state := sfile;	(* send file name *)
		    'Z' : state := seof;	(* end of file *)
		    'S' : state := sinit;	(* send-init *)
		    'B' : state := sbreak;	(* break-send *)
		    'C' : BEGIN sendsw := true; done := true END;
					(* complete *)
		    'A' : BEGIN sendsw := false; done := true END;
					(* abort *)
		    otherwise
			BEGIN sendsw := false; done := true END;
					(* unknown, so fail *)
		END; {case}
	END; {sendsw}
%page
    PROCEDURE init;    (* Initialize parameters *)
	BEGIN
	    delay[1] := 0;		(* set up initial packet delay *)
	    delay[2] := SNDINIT_DLY;
	    ascii := false;		(* We are using ASCII if true *)
	    debug := false;		(* For program development *)
	    if debug then		(* creating temporary debug file *)
		BEGIN
		(*  cmdnoe('$create -debug', 14);  *)
		    rewrite(bugfil, 'FILE=-debug');
		END;
	    reset(input, 'FILE=*msource* Interactive MAXLEN=255');
	    rewrite(output, 'FILE=*msink* MAXLEN=255');
				(* make wide as possible *)
	    new(packet);		(* Point to packet *)
	    new(recpkt);		(* make the space needed *)
	    eol := chr(CR);		(* EOL for outgoing packets *)
	    quote := MYQUOTE;		(* Standard control-quote char *)
	    pad := 0;			(* No padding *)
	    padchar := chr(NUL);	(* Use null if any padding wanted *)
	END;
%page
    BEGIN {main}
	datetime(date, time);
	writeln('Mathematical Reviews - Kermit on MTS.');
	writeln('The date is ', date, '.  The time is ', time, '.');
	writeln;
	writeln('For help see the file SJ1K:KERMIT.DOC.');
	writeln;
	init;				(* initialize all parameters *)
	writeln('Enter command - (r)eceive/(s)end:');
	readln(command);		(* get the command *)
	command := toupper(command);	(* convert to upper case *)
	writeln('Is column 1 reserved for carriage control (y/n)?');
	readln(ccinfo);
	cc := (toupper(ccinfo) = 'Y');
	if command = 'S' then		(* get the files to send *)
	    BEGIN
		nfiles := 0;
		writeln('Enter file names one at a time.');
		writeln('Terminate list with carriage return.');
		writeln;
		repeat
		    writeln('File to send:');
		    nfiles := nfiles + 1;
		    readln(filnam[nfiles]);
		until (nfiles >= MAXFILES) or (filnam[nfiles] = '')
	    END;
	setsys; 	(* set the terminal so Kermit will work *)
	case command of
	     'S' : BEGIN	(* send files *)
		       writeln;
		       write('Exit to your system, set IBM mode ON,');
		       writeln(' and initiate RECEIVE-FILE mode.');
		       writeln(chr(DC1));	(* write an XON *)
		       twait(0, delay); 	(* wait a while *)
		       numsent := 1;		(* none sent yet *)
		       if sendsw = false then	(* now go to send switcher *)
			   if debug then
			       writeln(bugfil, 'Send failed at - ',
				       filnam[numsent])
		       else if debug then writeln(bugfil, 'Send OK');
		   END;
	     'R' : BEGIN	(* receive files *)
		       writeln;
		       write('Exit to your system, set IBM mode ON,');
		       writeln(' and initiate SEND-FILE mode.');
		       if recsw = false then (* go to receive state switcher *)
			   if debug then writeln(bugfil, 'Receive failed.')
		       else if debug then writeln(bugfil, 'Receive OK.');
		    END;
	     otherwise	(* not a valid command *)
		 writeln('Invalid command given.');
	END; {case}
	close(bugfil);
	resetsys;	(* return terminal to original state *)
    END.  {Kermit}