{
	Program :  KERMIT.PAS           - Main program 
		     PARSER.PAS         - Kermit Command Parser 
		     PGLOBAL.PAS        - Parser Global Definitions 
		     VERSION.PAS 	- Version header & prompts	
		     VTERM.FOR          - Kermit Virtual Terminal Program 
		     VTGLOBAL.FOR       - Virtual Terminal Global Definitions 

	Author :   Philip Murton - original RT-11 pascal program,
		   Bruce W. Pinn - modified version for VMS 3.x
					added regular command parser,
					virtual terminal support,
					pretty pascal code.

	Date :  April 28, 1983
	Site :  University of Toronto
		Computing Services

	Abstract :
	     This program implements the KERMIT protocol under VAX/VMS.  KERMIT
	is an acronym for the expression "KL-10 Error-Free Reciprocol
	Microcomputer Interchange over TTY-Lines".  For more information on
	Kermit please refer to the documentation included with this distri-
	bution.
	     This version of KERMIT, with its virtual terminal support, may
	be used as a local, or remote kermit.

	Bug Fixes :
		01-JUN-83  BWP  Reset packet pointer to zero after each
				file group send/receive to satisfy UNIX
				kermit.

		01-JUN-83  BWP  Fixed file handling so that if incoming line
				exceeds 133 then it is wrapped to next line.

		08-AUG-83  BWP  Fixed getfile so that routine will open an
				incoming file of xxx to xxx. as opposed to
				xxx.DAT.

		09-AUG-83  BWP  Fixed parsing routine to strip off leading
				blanks from user command.

		09-AUG-83  BWP  Fixed parsing routine to allow `?' to be
				specified after send or receive command.

		10-AUG-83  BWP  Fixed bug so that when remote connection
				generates hangup, the user cannot type conn
				to reconnect.  This also fixes the gobbled
				character problem (actually now only one 
				gobbled character).

		11-AUG-83  BWP  Added dcl call to parser.

		11-AUG-83  BWP  Turned off control-(c/y) checking.

		15-AUG-83  BWP  Adjusted code to check local user for input
				during send.  (Allow abort, and retransmit
				packets.)

		29-SEP-83  BWP  Fixed code so that before each send the
				find_file/next file pointer is reset to zero.

		29-SEP-83  BWP  Turned off sysprv priviledge after allocating
				the remote port.

		01-NOV-83  BWP  Turned on, then off control-y handling when
				execing DCL.

		01-NOV-83  BWP  Fixed bug so that when user performs transfer
				abort the diskfile is appropriately closed.

		01-NOV-83  BWP  Fixed bug so that when user aborts, or error
				occurs during a file open, an error packet is
				sent to the remote kermit.

		19-NOV-83  BWP  Placed kludge in SLEEPVMS to avoid the problem
				with chr function in PASCAL 2.2.

		28-NOV-83  BWP  Fixed the parsing of the receiveinit packet
				so that the quote character was interpretted
				correctly.

		20-DEC-83  BWP	Provided eight-bit quoting facility for the
				program.
				(Version 1.1)

		22-MAY-84  PTM	Add error messages for file opens and add
				flush of TypeAhead in SendInit.
				Add message for non-ascii send in Text file.
				(Version 1.1A)

		23-JUL-84  PTM	On unsucessful receive delete file.
				Modify ErrorPack 
				(Version 1.1B)				  

		26-JUL-84  PTM	Increase line length for Text file to 255
				on write.
				Fix DataToFile for <CR><CR><LF> sequence.
				(Version 1.1C)				  

		10-AUG-84  PTM	GetData does not quote properly !!
				(Version 1.1D)				  

		22-AUG-84  PTM	Fix GetData for DEL.
				Modify ErrorPack.
				(Version 1.1E)				  
				}


{ TOP OF PROGRAM }
[inherit('SYS$LIBRARY:STARLET')]
program Kermit(input,output,file3,file4,binfile,helpfile);

label 
      9999;               { used only to simulate a "halt"  instruction }

const 

    { standard file descriptors. subscripts in open, etc. }
      STDIN = 1;          { these are not to be changed }
      STDOUT = 2;
      STDERR = 3;
      LOCALCHAN = 5;
      REMOTECHAN = 6;

    { other io-related stuff }
      IOERROR = 0;        { status values for open files  }
      IOAVAIL = 1;
      IOREAD = 2;
      IOWRITE = 3;
      MAXOPEN = 6;        { maximum number of open files  }

    { eight bit stuff }
      SBIT = 7;
      EBIT = 8;
      BLKSIZE = 512;

    { universal manifest constants  }
      NULL = 0;
      ENDSTR = -255;         { null-terminated strings }
      ENDFILE = -256;
      ENDOFQIO = -257;
      MAXSTR = 100;       { longest possible string }
      CONLENGTH = 20;     { length of constant string }
      MAXCHARPERLINE = 255; { Maximum number of characters for file line }
      STDCHARPERLINE = 133; { Standard number of characters for file line }

    { ascii character set in decimal }
      BACKSPACE = 8;
      TAB = 9;
      NEWLINE = 10;
      BLANK = 32;
      EXMARK = 33;
      SHARP = 35;
      AMPERSAND = 38;
      PERIOD = 46;
      RABRACK = 62;
      QUESTION = 63;
      GRAVE = 96;
      TILDE = 126;
      LETA = 65;
      LETZ = 90;
      LETsa = 97;
      LETsz = 122;
      LET0 = 48;
      LET9 = 57;

      SOH = 1;            { ascii SOH character }
      CR = 13;            { CR }
      DEL = 127;          { rubout }

      DEFTRY = 5;         { default for number of retries }
      DEFITRY = 10;       { default for number of retries on init }
      DEFTIMEOUT = 20;    { default time  out }
      MAXPACK = 94;       { max is 94 }
      DEFDELAY = 5;      { delay before  sending first init }
      NUMPARAM = 7;       { number of parameters in init packet }
      DEFQUOTE = SHARP;   { default quote character   }
      DEFEBQUOTE = AMPERSAND;
      DEFPAD = 0;         { default number of padding chars   }
      DEFPADCHAR = 0;     { default padding character  }

    { SYSTEM DEPENDENT }
      DEFEOL = CR;

    { packet TYPES  }

      TYPEB  = 66;    { ord('B') }
      TYPED  = 68;    { ord('D') }
      TYPEE  = 69;    { ord('E') }
      TYPEF  = 70;    { ord('F') }
      TYPEN  = 78;    { ord('N') }
      TYPES  = 83;    { ord('S') }
      TYPET  = 84;    { ord('T') }
      TYPEY  = 89;    { ord('Y') }
      TYPEZ  = 90;    { ord('Z') }

      MAXCMD = 10;

    { Virtual Terminal Support }
      LOCALONLY = 0;
      LOCALREMOTE = 1;

    { VMS qio buffer size }
      VMSBUFSIZE = 512;
      SLEEPEFN = 10;

    { Command parser constants }
      SMALLSIZE = 13;
      LARGESIZE = 80;
      MINPACKETSIZE = 10;
      MAXPACKETSIZE = 94;

      %include   'kermdir:pglobal.pas'

type 
     character = ENDOFQIO..127;     { byte-sized. ascii + other stuff }
     schar = -128..127;
     wordInteger = 0..65535;
     string = array [1..MAXSTR] of character;
     vstring = record
		   len : integer;
		   ch  : array [1..MAXSTR] of char;
	       end;
     cstring = PACKED array [1..CONLENGTH] of char;
     filedesc = IOERROR..MAXOPEN;
     ioblock = record                { to keep track of open files }
		   filevar : text;
		   mode : -IOWRITE..IOWRITE;
		   ftype : SBIT..EBIT;
	       end;

    { Eight bit file stuff }
     block = packed array[1..BLKSIZE] of char;
     binfiletype = file of block;
     EBQtype = (Ascii, Binary);

    { Data  TYPES for Kermit }
     Packet = RECORD
		   mark : character;       { SOH character  }
		   count: character;       { # of bytes following this field }
		   seq  : character;       { sequence number modulo 64  }
		   ptype: character;       { d,y,n,s,b,f,z,e,t  packet type }
		   data : string;          { the actual data }
	      end;
    { chksum is last validchar in data array }
    { eol is added, not considered  part of packet proper }

     timeArray = packed array[1..2] of integer;
     Command = (Transmit,Receive,Invalid,Connect);
     KermitStates = (FileData,Init,Break,FileHeader,EOFile,Complete,Abort);
     EOLtype = (LineFeed,CrLf,JustCr);

     Words = (Low,High);
     Stats = integer;
     Ppack = ^Packet;

     Intype = (nothing,CRin,abortnow);

    {  Parser defined types }
     vmsString = varying[255] of char;
     $UBYTE = [BYTE] 0..255;
     string13 = packed array [1..SMALLSIZE] of char;
     string80 = packed array [1..LARGESIZE] of char;

var 
    openlist : array [1..MAXOPEN] of ioblock; { open files  }
    cmdargs  : 0..MAXCMD;
    cmdlin   : string;
    cmdidx   : array [1..MAXCMD] of 1..MAXSTR;
    file3,file4,helpfile : text;
    file3cnt, file4cnt : integer;

    { varibles for  Kermit }
    DiskFile : filedesc;     { File being read/written }
    SaveState : kermitstates;
    NextArg  : integer;      { next argument to process }
    local    : boolean;      { local/remote flag }
    MaxTry   : integer;
    n        : integer;      { packet number }
    NumTry   : integer;      { times this packet retried }
    OldTry   : integer;
    Delay    : integer;
    Pad, MyPad : integer;      { number of padding characters I need  }
    PadChar, MyPadChar: character;
    MyTimeOut, TheirTimeOut : integer;
    timeOutStatus, fudge : boolean;
    Runtype, oldRunType  : command;
    State    : kermitstates;

    LineIN, LineOUT, ControlIN,ControlOUT : filedesc;
    SizeRecv, SizeSend : integer;
    SendEOL, SendQuote : character;
    myEOL,myQuote: character;
    EOLFORFILE : EOLtype;
    NumSendPacks, NumRecvPacks : integer;
    NumACK, NumNAK : integer;
    NumACKrecv, NumNAKrecv, NumBADrecv : integer;
    RunTime : integer;
    startTime, endTime: timeArray;
    ChInFileRecv, ChInPackRecv, ChInFileSend, ChInPackSend : Stats;
    Debug : boolean;
 					
    { Check for received file - was it OK ? }
    TransferOK : boolean;   
    
    ThisPacket :    Ppack;  { current packet being  sent }
    LastPacket :    Ppack;  { last  packet sent }
    CurrentPacket : Ppack;  { current packet received }
    NextPacket :    Ppack;  { next  packet being received }
    InputPacket : Ppack;    { save  input to do debug }

    { these are used for the Receive Packet procedures }
    FromConsole : Intype;   { input from Console during     receive }
    check: integer;         { Checksum }
    PacketPtr : integer;    { pointer to InputPacket }
    dataptr : integer;      { pointer to data of Packet }
    fld : 0..5;             { current fld number }
    t : character;          { input character }
    finished : boolean;     { finished packet ? }
    restart : boolean;      { restart packet ? }
    control : boolean;      { quoted ? }
    isgood : boolean;       { packet is good  ? }

    {  Virtual Terminal Connect Parameters  }
    localChannel, remoteChannel : integer;
    locWriteFunc, locReadFunc : integer;
    remWriteFunc, remReadFunc : integer;
    vTermSetType : integer;
    invalidConnection : boolean;

    {  VMS qiow read buffer, and pointers. }
    vmsReadModifer : integer;
    vmsReadBuff, vmsWriteBuff : packed array[1..VMSBUFSIZE] of schar;
    vmsChRead, curBuffPoint, vmsWritePnt, vmsFilePnt, stat : integer;
    ctrlOff : integer;
    fileExists, lastFile, vmsWriteFlg : boolean;

    {  VMS routine exit handler vars. }
    exitStatus : integer;

    { Eight Bit Quoting Info }
    sentEBQuote, recvdEBQuote, needEBQuote : boolean; { Used for determining 8 bit state }
    EBQState : EBQtype;			 { ... }
    EBQchar : character;		 { Quote character for 8 bit trans }
    binfile : binfiletype;		 { Binary file }
    ishigh : integer;			 { Shift to put high bit on }
    binascflg : -1..1;			 { State of file open binary/ascii }
    binbuffer : block;			 { Buffer for binary data }
    binptr : integer;			 { Binary buffer pointer }
    
    {  Parser defined variables }
    commandLine, fileSpec : string80;
    exitProgram : boolean;
    localEcho, sFileSpec, rFileSpec, lSpeed, transtype : integer;
    escape, debugging, commandLen, fileEol, parity : integer;


procedure SetUpVirtualTerminal(var remChanl : integer;
			       var remRFunc : integer;
			       var remWFunc : integer;
			       var locChanl : integer;
			       var locRFunc, locWFunc,
				   status, setType, locEcho,
				   parity, speed  : integer) ;
fortran;


procedure SetUpExitHandlerVMS(swapm, priority : integer);
fortran;

[asynchronous, external (LIB$DISABLE_CTRL)]

function $Disable_Ctrl
      ( var mask : integer := %immed 0)
   : integer;
external;

[asynchronous, external (LIB$ENABLE_CTRL)]

function $Enable_Ctrl
      ( var mask : integer := %immed 0)
   : integer;
external;

[asynchronous, external (LIB$FIND_FILE)]

function $Find_File
      ( var fileName : varying[$l1] of
				char := %immed 0;
	var resultName : varying[$l2] of
				char := %immed 0;
	var context : integer := %immed 0;
	var defaultName : varying[$l3] of
				char := %immed 0;
	var relatedName : varying[$l4] of
				char := %immed 0 )
   : integer;
external;

[asynchronous, external (LIB$SPAWN)]

function $Spawn
      ( var shelline : varying[$ll1] of
				char := %immed 0)
   : integer;
external;

[asynchronous, external (LIB$SUBX)]

function $Subx
      ( var a : timeArray;
	var b : timeArray;
	var c : timeArray)
   : integer;
external;


[asynchronous, external (LIB$EDIV)]

function $Ediv
      ( var divisor   : integer := %immed 0;
	var dividend  : timeArray;
	var quotient  : integer := %immed 0;
	var remainder : integer := %immed 0)
   : integer;
external;


procedure DebugMessage(c : cstring);
forward;


procedure PutCln( x:cstring;
		       fd:filedesc);
forward;


procedure AddTo( var sum : Stats;
		  inc:integer);
forward;


procedure PutCN( x:cstring;
		 v : integer;
		 fd:filedesc);
forward;


procedure FinishUp(noErrors : boolean);
forward;


procedure ErrorPack(c:cstring);
forward;


procedure ProgramHalt; { used by external  procedures for halt }
begin
    GOTO 9999
end;

procedure Greeting; {Kermit Version Message}
const
%include   'kermdir:version.pas'
begin
    writeln(VERSION);		
end;

{ initio  -- initialize open file list  }

procedure Initio;

var 
    status : integer;
    i : filedesc;
begin
    controlIN := STDIN;
    controlOUT := STDOUT;

    openlist[STDIN].mode := IOREAD;
    openlist[STDOUT].mode := IOWRITE;
    openlist[STDERR].mode := IOWRITE;

   { connect STDERR to  user's terminal ... }

    open(FILE_VARIABLE := file3,
	 FILE_NAME := 'SYS$ERROR');

    rewrite(file3);

    file3cnt := 0;

   { initialise all files to seven bit as default }
    for i := STDIN to MAXOPEN do
	openlist[i].ftype := SBIT;

   { initialize rest of files }
    for i := STDERR+1 to MAXOPEN do
	openlist[i].mode := IOAVAIL;

    {  Initialize the local channel }
    vTermSetType := LOCALONLY;
    invalidConnection := false;
    SetUpVirtualTerminal(remoteChannel, remReadFunc, remWriteFunc,
			 localChannel, locReadFunc, locWriteFunc,
			 status, vTermSetType, localEcho, parity, lSpeed);
    if (status <> ss$_normal) then
	invalidConnection := true;

    openlist[LOCALCHAN].mode := IOREAD;
end;


function Sopen (name : string; mode : integer) : filedesc;
{ Sopen  -- open a file for reading or  writing }

var 
	i : integer;
	intname : PACKED array [1..MAXSTR] of char;
	found : boolean;

procedure Iopen(var f : text;
		var binf : binfiletype;
		var linelen : integer);
begin
    linelen := 0;
    case openlist[i].mode of

	IOERROR,
	IOAVAIL : { Do Nothing; this should actually not happen };

	IOREAD :
	    begin
		open(FILE_VARIABLE := f,
		     FILE_NAME := intname,
		     RECORD_LENGTH := 255,
		     HISTORY := OLD,
		     ERROR := CONTINUE);
		if (status(f) <> NULL) then
		    begin
			openlist[i].mode := IOAVAIL;
			i := IOERROR;
			fileExists := false
		    end
		else
		    begin
			reset(f, ERROR := CONTINUE);
			openlist[i].ftype := SBIT;
		    end;
	    end;

	-IOREAD :
	    begin
		open(FILE_VARIABLE := binf,
		     FILE_NAME := intname,
		     RECORD_TYPE := FIXED,
		     CARRIAGE_CONTROL := NONE,
		     RECORD_LENGTH := 512,
		     HISTORY := OLD,
		     ERROR := CONTINUE);
		if (status(binf) <> NULL) then
		    begin
			openlist[i].mode := IOAVAIL;
			i := IOERROR;
			fileExists := false
		    end
		else
		    begin
		    	reset(binf, ERROR := CONTINUE);
			openlist[i].ftype := EBIT;
			binbuffer := binf^;
			binptr := 1;
		    end;
	    end;

	IOWRITE :
	    begin
		open(FILE_VARIABLE := f,
		     FILE_NAME := intname,
		     RECORD_LENGTH := 255,
		     HISTORY := NEW,
		     ERROR := CONTINUE);
		if (status(f) <> 0) then
		    begin
			openlist[i].mode := IOAVAIL;
			i := IOERROR;
		    end
		else
		    begin
		        rewrite(f, ERROR := CONTINUE);
			openlist[i].ftype := SBIT;
		    end;
	    end;

	-IOWRITE:
	    begin
		open(FILE_VARIABLE := binf,
		     FILE_NAME := intname,
		     RECORD_TYPE := FIXED,
		     CARRIAGE_CONTROL := NONE,
		     RECORD_LENGTH := 512,
		     HISTORY := NEW,
		     ERROR := CONTINUE);
		if (status(binf) <> 0) then
		    begin
			openlist[i].mode := IOAVAIL;
			i := IOERROR;
		    end
		else
		    begin
			rewrite(binf, ERROR := CONTINUE);
			openlist[i].ftype := EBIT;
		    end;
		binptr := 1;
	    end;
    end;

end;

begin
	i := 1;
	DebugMessage ('Sopen...            ');
	while (name[i] <> ENDSTR) and (name[i] <> NEWLINE) do
	    begin
		intname[i] := chr(name[i]);
		i := i + 1
	    end;

	for i := i to MAXSTR do
		intname[i] := ' ';      { pad name with blanks  }


	{ find  a free slot in openlist }
	Sopen := IOERROR;
	found := false;
	i := 1;
	while (i <= MAXOPEN) and (not found) do
	    begin
		if (openlist[i].mode = IOAVAIL) then
		    begin
		        openlist[i].mode := mode;
			case i of
			    1:      { nothing };
			    2:      { nothing };
			    3:      { nothing };
			    4:      Iopen(file4, binfile, file4cnt);
			end;
			Sopen := i;
			found := true
		    end;
		i := i + 1
	    end
end;

function getc (var c : character) : character;
{ getc  (UCB) -- get one character from standard input }

var 
	ch : char;
begin
    if eof then
	c := ENDFILE
    else if eoln then
	begin
	    readln;
	    c := NEWLINE
	end
     else
	begin
	    read(ch);
	    c := ord(ch)
	end;
     getc := c
end;


function Getcf (var c: character; fd : filedesc) : character;
{ getcf  -- get one character from file }

var 
    ch : char;

procedure Getcfx(VAR f:text);
begin
    if eof(f) then
	c := ENDFILE
    else if eoln(f) then
	begin
	    readln(f);
	    c := NEWLINE
	end
    else
	begin
	    read(f, ch);
	    c := ord(ch)
	end;
end;

procedure GetBinary(var c : character);
var
	x : packed record
		case boolean of
		    true : (c : char);
		    false: (i : -128..127);
	        end;
	i : integer;
begin
    if binptr > BLKSIZE then
	begin
	    get(binfile, ERROR := CONTINUE);
	    if eof(binfile) then
		c := ENDFILE
	    else
		begin
		    binptr := 1;
		    binbuffer := binfile^;
		    GetBinary(c);
		end;
	end
    else
	begin
	    x.c := binbuffer[binptr];
	    c := x.i;
	    binptr := binptr + 1;
	end;
end;

begin
    case fd of
	STDIN :
	    Getcf := getc(c);
	STDERR :
	    Getcfx(file3);
	4 :
	    case openlist[fd].ftype of
		SBIT : Getcfx(file4);
		EBIT : GetBinary(c);
	    end;
	LOCALCHAN :
	    PutCln('Read of local chan. ', STDERR);
	REMOTECHAN :
	    PutCln('Read of remote Chan.', STDERR);
    end;

    Getcf := c
end;


function GetVmsPacket (fd : filedesc) : integer;
{  Function to get a block of text from the incomming channel. }

function GetBlockVMS(channel, channelReadFunc : integer) : integer;


var 
    status : integer;
    info, addrCh, addrIosb : integer;
    ch : char;
    channelTerminator : packed array[1..2] of integer;
    channelIosb : packed array[1..4] of wordInteger;
begin

    DebugMessage('GetBlockVMS...      ');
    curBuffPoint := 0;
    timeOutStatus := false;
    channelTerminator[1] := 0;
    channelTerminator[2] := 2**myEol;
    channelReadFunc := channelReadFunc + vmsReadModifer;

    status := $QIOW(,%immed (channel),
		     %immed (channelReadFunc),
		     channelIosb,,,
		     vmsReadBuff,
		     %immed (VMSBUFSIZE),
		     %immed (TheirTimeOut),
		     %ref (channelTerminator),,);

    if ( not(odd(status)) or  not(odd(channelIosb[1]))) then
	timeOutStatus := true;

    GetBlockVms := channelIosb[2] + channelIosb[4];
end;

begin
    if (openlist[fd].mode <> IOREAD) then
	begin
	    PutCln('Getcf:  mode=IOREAD ', STDERR);
	    ProgramHalt;
	end;
    case fd of
	LOCALCHAN: 
	    GetVmsPacket := GetBlockVms(localChannel,
						locReadFunc);
	REMOTECHAN:
	    GetVmsPacket := GetBlockVms(remoteChannel,
						remReadFunc);
    end;
end;

procedure FlushTypeAhead(mode : boolean);
{ Flush TypeAhead buffer for input line }
begin
    if mode then 
	vmsReadModifer := IO$M_TIMED + IO$M_PURGE
    else
	vmsReadModifer := IO$M_TIMED;
end;

procedure PutBinary(c : character);
var
    i : integer;
begin
    if (c = ENDFILE) then
	begin	{ Flush the Buffer }
	    while (binptr <= BLKSIZE) do
		begin
		    binbuffer[binptr] := chr(NULL);
		    binptr := binptr + 1;
		end;
	    c := NULL;
	end;
    if (binptr > BLKSIZE) then
	begin
	    binfile^ := binbuffer;
	    put(binfile);
	    binptr := 1;
	    PutBinary(c);
	end
    else
	begin
	    binbuffer[binptr] := chr(c);
	    binptr := binptr + 1;
	end;
end;


procedure Putc (c : character);
{ putc  (UCB) -- put one character on standard output }
begin
    if c = NEWLINE then
	writeln
    else
	write(chr(c));
end;


procedure Putcf (c : character; fd : filedesc);
{ putcf  -- put a single character on file fd }

procedure Putcfx(var f:text;
		 var linelen : integer;
		     maxforline :integer);
begin
    linelen := linelen + 1;
    IF (c = NEWLINE) then
	begin
	    linelen := 0;
	    writeln(f);
	end
    else
	if (linelen > maxforline) then
	    begin
		linelen := 1;
		writeln(f);
		write(f, chr(c))
	    end
	else
	    write(f, chr(c));
end;

procedure PutCVMS(    channel, channelWriteFunc : integer;
		  var totalChars : integer);

var 
    status : integer;
    channelIosb : packed array[1..2] of integer;
begin
    status := $QIOW(,%immed (channel),
		     %immed (channelWriteFunc),
		     channelIosb,,,
		     %ref (vmsWriteBuff),
		     %immed (totalChars),,,,);

    {  Reset put buffer pointer }
    vmsWritePnt := 0;

    if (not(odd(status))) then
	PutCN('PutCVMS : bad qiow  ', status, STDERR);

end;


procedure BufferPutVMS(var  currentPntr : integer;
			    c : character);
{  Buffer the character to be written. }
begin
    vmsWritePnt := vmsWritePnt + 1;

    if (vmsWritePnt > VMSBUFSIZE) then
	begin
	    FinishUp(true);
	    ProgramHalt;
	end;

    if (c <> Pad) and (c <> sendEOL) then
        AddTo(ChInPackSend, 1);

    vmsWriteBuff[vmsWritePnt] := c;
end;


begin
    case fd of
	STDOUT :
	    Putc(c);
	STDERR :
	    Putcfx(file3, file3cnt, STDCHARPERLINE);
	4 :
	    case openlist[fd].ftype of
		SBIT : Putcfx(file4, file4cnt, MAXCHARPERLINE);
		EBIT : PutBinary(c);
	    end;
	LOCALCHAN : 
	    if (vmsWriteFlg) then
		PutcVMS(localChannel, locWriteFunc, vmsWritePnt)
	    else
		BufferPutVMS(vmsWritePnt, c);
	REMOTECHAN : 
	    if (vmsWriteFlg) then
		PutcVMS(remoteChannel, remWriteFunc, vmsWritePnt)
	    else
		BufferPutVMS(vmsWritePnt, c);
    end;
end;


procedure FlushPutBufferVMS;
{  Flush the put buffer by writing it out to the remote channel. }

var 
    c : character;
begin
    vmsWriteFlg := true;
    PutCf(c, LineOut);
    vmsWriteFlg := false;
end;


procedure PutStr (var s : string; f : filedesc);
{ putstr (UCB)  -- put out string on file }

var 
    i : integer;
begin
    i := 1;
    while (s[i] <> ENDSTR) do
	begin
	    Putcf(s[i], f);
	    i := i + 1
	end
end;


procedure Sclose (var fd : filedesc);
{  Close a File descriptor }
var  
   DeleteOnClose : boolean;  
begin
    if (fd > STDERR) and (fd <= MAXOPEN) then
	begin

	    { Check if file received was OK } 			

	    DeleteOnClose :=  ( abs(openlist[fd].mode) = IOWRITE) and 	
				(not TransferOK); 

	    case fd of
		1:      { nothing };
		2:      { nothing };
		3:
		    close(file3, ERROR := CONTINUE);
		4:
		    case openlist[fd].ftype of
			SBIT : 
			    if DeleteOnClose then 
				close(file4, DISPOSITION := DELETE,
					ERROR := CONTINUE)
			    else				    
				close(file4, ERROR := CONTINUE);
			EBIT :
			    begin
				if (openlist[fd].mode = -IOWRITE) then
				    PutBinary(ENDFILE);
				if DeleteOnClose then 
					close(binfile, DISPOSITION := DELETE,
						ERROR := CONTINUE)
				else
					close(binfile, ERROR := CONTINUE);
			    end;
		    end;
	    end;
	    openlist[fd].mode := IOAVAIL;
    	end;
    fd := IOERROR;
end;


function ItoC (n : integer; var s : string; i : integer)
		: integer;      { returns end of s }
{ ItoC  - convert integer n to char string in s[i]... }
begin
    if (n < 0) then
	begin
	    s[i] := ord('-');
	    ItoC := ItoC(-n, s, i+1)
	end
    else
	begin
	    if (n >= 10) then
		i := ItoC(n div 10, s, i);
	    s[i] := n mod 10 + ord('0');
	    s[i+1] := ENDSTR;
	    ItoC := i + 1
	end
end;


function LengthSTIP (var s : string) : integer;
{ lengthSTIP -- compute length of string }

var 
    n : integer;
begin
    n := 1;
    while (s[n] <> ENDSTR) do
	n := n + 1;
    LengthSTIP := n - 1
end;


procedure Scopy (var src : string; i : integer;
		 var dest : string; j : integer);
{ scopy -- copy string  at src[i] to dest[j] }
begin
    while (src[i] <> ENDSTR) do
	begin
	    dest[j] := src[i];
	    i := i + 1;
	    j := j + 1
	end;
    dest[j] := ENDSTR
end;


function IsUpper (c : character) : boolean;
{ isupper -- true if c  is upper case letter }
begin
    isupper := (c >= ord('A')) and (c <= ord('Z'))
end;


function IndexSTIP (var s : string; c : character) : integer;
{ IndexSTIP -- find position of character c in string s }

var 
    i : integer;
begin
    i := 1;
    while (s[i] <> c) and (s[i] <> ENDSTR) do
	i := i + 1;
    if (s[i] = ENDSTR) then
	IndexSTIP := 0
     else
	IndexSTIP := i
end;


procedure CtoS( x:cstring;  var s:string);
{ convert constant to STIP string }

var 
    i : integer;
begin
    for i:=1 to CONLENGTH do
	s[i] := ord(x[i]);
    s[CONLENGTH+1] := ENDSTR;
end;


function Exists( s:string):  boolean;
{ returns true  if file exists }

var 
    fd:  filedesc;
    result: boolean;
    temp : character;
    dummy: boolean;
begin
    DebugMessage ('Exists...           ');
    fileExists := true;
    fd   := Sopen(s,IOREAD*binascflg);
    Sclose(fd);
    Exists := fileExists;
end;


procedure PutCon( x:cstring;
		   fd:filedesc);
{ output literal }
var 
    s: string;
begin
    CtoS(x,s);
    PutStr(s,fd);
end;


procedure PutCln;
{ output literal followed by NEWLINE }
begin
    PutCon(x,fd);
    Putcf(NEWLINE,fd);
end;


procedure PutNum( n:integer;
		  fd:filedesc);
{ Ouput number  }

var 
    s: string;
    dummy: integer;
begin
    s[1] := BLANK;
    dummy := ItoC(n,s,2);
    PutStr(s,fd);
end;


procedure PutCS( x:cstring;
		 s : string;
		 fd:filedesc);
{ output literal & string }
begin
    PutCon(x,fd);
    PutStr(s,fd);
    Putcf(NEWLINE,fd);
end;


procedure PutCN;
{ output literal & number }
begin
    PutCon(x,fd);
    PutNum(v,fd);
    Putcf(NEWLINE,fd);
end;


procedure AddTo;
begin
    sum := sum + inc;
end;


procedure OverHd( p,f: Stats;
		  var o:integer);
{ Calculate OverHead as % }
{ 0verHead := (p-f)*100/f }
begin
    if (f <> 0) then
	o := ((p - f)*100) div f
    else
	o := 100;
end;


procedure CalRat( f:   Stats;
		  t:integer;
		  var r:integer);
{ Calculate Effective Baud Rate }
{ Rate  = f*10/t }
begin
    if (t <> 0) then
	r := (f * 10) div t
    else
	r := 0;
end;


procedure BadVTerminalConnect;
{ Inform user that connection was not valid. }
begin
    PutCon(' ? VTerm Connection ',ControlOUT);
    PutCln('not established     ',ControlOUT);
end;


procedure DebugMessage;
{ Print writeln if debug }
begin
    if debug then
	Putcln(c,STDERR);
end;


procedure DebugMessNumb(s : cstring; val : integer);
{ Print message and a number }
begin
    if debug then
	begin
	    Putcln(s, STDERR);
	    PutNum(val, STDERR);
	end;
end;


procedure CopyStringVMS(var fileSpec : string80;
			var newFile : string);
{  System dependent procedure to copy a VMS string to a STIP string }

var 
    tempFile : cstring;
    i : integer;
begin
    tempFile := '                    ';
    for i:=1 to CONLENGTH do
	tempFile[i] := fileSpec[i];
    CtoS(tempFile, newFile);
end;


procedure CheckTypeAhead(var consoleChar : InType);

const 
      ABORTCONs = 'a';
      ABORTCONL = 'A';

type 

     $UBYTE = [byte] 0..255;
     $WORD =  [word] -32768..32767;
     blotto = [unsafe] array[1..500] of $UBYTE;
     typeAhead = packed record
			    case boolean of
				true : ( a : blotto);
				false: ( b : [unsafe] array[1..250] of $WORD);
			   end;

var 
    infoTypeAhead : typeAhead;
    blottoreal : blotto;
    statqiow, sensemode, i, typeAheadCnt : integer;
    tempChar : character;

begin

    consoleChar := nothing;

    sensemode := io$_sensemode + io$m_typeahdcnt;
    statqiow := $qiow(,
		       localChannel,
		       sensemode,,,,
		       blottoreal,,,,,);

    for i:=1 to 8 do
	infoTypeAhead.a[i] := blottoreal[i];

    typeAheadCnt := infoTypeAhead.b[1];

    if (typeAheadCnt > 0) then
	begin
	    statqiow := $qiow(,
			       localChannel,
			       locReadFunc,,,,
			       blottoreal,
			       typeAheadCnt,,,,);
	    tempChar := blottoreal[1];
	    if ((tempChar = ord(ABORTCONs)) or (tempChar = ord(ABORTCONL))) then
		begin
		    consoleChar := abortnow;
		    if (local) then
			PutCln('Aborting Transfer   ', STDERR)
		end
	    else if (tempChar = CR) then
		begin
		    consoleChar := CRin;
		    if (local)
			then
			    PutCln('Resending Packet    ', STDERR)
		end;
	end;

end;


procedure ClockVMS(var timeState : timeArray);
{  System dependent routine to obtain clock time from VMS. }

var 
    status : integer;
begin
    status := $gettim(timeState);
    if (status <> ss$_normal) then
	PutCN('Bad sys$gettim      ',status, STDERR);

end;


function TotalRunTimeVMS(startTime, endTime : timeArray) : integer;
{  Calculate the total runtime for the transfer }

var 
    tempTime3 : timeArray;
    status, i, quotient, remainder, million : integer;
begin

    status := $Subx(endTime, startTime, tempTime3);
    if (status <> ss$_normal) then
	PutCN('Bad multi-add $addx ',status, STDERR);

    million := 10000000;
    status := $ediv(million, tempTime3, quotient, remainder);
    if (status <> ss$_normal) then
	PutCN('Bad multi-div $ediv ', status, STDERR);

    TotalRunTimeVMS := quotient;
end;


procedure SleepVMS( t:integer);   { pause for t seconds }
{  System Dependent routine for VMS }

type 
    { Data TYPES for VMS dependent code }
     $quad = [quad,unsafe] record
			       l0 : unsigned;
			       l1 : integer;
			  end;

var 
    sleepLength : vmsString;
    timConvert : string;
    endPos, status, i : integer;
    binaryTime : $quad;
    kludgechar : char;

begin
    DebugMessage('Sleep...            ');
    sleepLength := '0 00:0';
    if ( (t mod 60) = 1) then
	begin
	    sleepLength := sleepLength+'1:';
	    t := t rem 60;
	end
    else
	sleepLength := sleepLength+'0:';

    endPos := ItoC(t, timConvert, 1);

    if (endPos = 2) then
	sleepLength := sleepLength+'0';

    for i:=1 to (endPos-1) do
	begin
	    kludgechar := chr(timConvert[i]);
	    sleepLength := sleepLength+kludgechar;
	end;

    status := $BINTIM(sleepLength, binaryTime);
    if (not(odd(status)) and (local)) then
	PutCln('Sleep: Illegal time ', STDERR);

    status := $SETIMR(SleepEFN, binaryTime);
    if (not(odd(status)) and (local)) then
	PutCln('Sleep: Bad set time ', STDERR);

    status := $WAITFR(SleepEFN);
    if (not(odd(status)) and (local)) then
	PutCln('Sleep : Hibernation ', STDERR);

end;


procedure PutPacket( p : Ppack); { Output Packet }

var 
    i : integer;
begin
    DebugMessage('PutPacket...        ');
    if (Pad >0) then
	for i := 1 to Pad do
	    Putcf(PadChar,LineOut);
     with p^ do
	 begin
	     Putcf(mark,LineOut);
	     Putcf(count,LineOut);
	     Putcf(seq,LineOut);
	     Putcf(ptype,LineOut);
	     PutStr(data,LineOut);
	 end;

     FlushPutBufferVMS;
end;


function GetIn  : character;  { get character    }
{ Should return NULL ( ENDSTR ) if  no characters }

var 
	c : character;
begin
    curBuffPoint := curBuffPoint + 1;

    if (curBuffPoint <= vmsChRead) then
	c := vmsReadBuff[curBuffPoint]
    else
	c := ENDOFQIO;
    GetIn := c;
    if (c <> NULL) then
	    AddTo(ChInPackRecv,1)
end;


function MakeChar(   c:character):  character;
{ convert integer to printable }
begin
    MakeChar := c+BLANK;
end;


function UnChar( c:character):  character;
{ reverse of makechar }
begin
    UnChar := c - BLANK
end;


function IsControl( c:character):  boolean;
{ true if control }
begin
    if (c >= NULL) then
	IsControl := (c = DEL ) or (c < BLANK )
    else
	IsControl := IsControl(c + 128);
end;


function Ctl( c:character):  character;
{ c XOR 100 }
begin
    if (c >= NULL) then
	if (c < 64) then
	    c := c + 64
	else
	    c := c-64
    else
	c := Ctl(c + 128) - 128;

    Ctl := c;
end;


function Checkfunction( c:integer):  character;
{ calculate checksum }

var 
    x: integer;
begin
    DebugMessage('Checkfunction...    ');
    {    Checkfunction := (c + ( c and 300 ) /100 ) and 77; }
    x := (c MOD 256 ) DIV 64;
    x := x+c;
    Checkfunction := x MOD 64;
end;


procedure SetEBQuoteState;
begin
    if (EBQState = Binary) then
	begin
	    transType := oBINARY;
	    binascflg := oBINSTATE;
	end
    else
	begin
	    transType := oASCII;
	    binascflg := oASCSTATE;
	end;
end;


procedure EnCodeParm( var data:string);    { encode parameters }

var 
    i: integer;
begin
    DebugMessage('EnCodeParm...       ');
    for i:=1 to NUMPARAM do
	data[i] := BLANK;
    data[NUMPARAM+1] := ENDSTR;
    data[1] := MakeChar(SizeRecv);          { my  biggest packet }
    data[2] := MakeChar(MyTimeOut);         { when I want timeout}
    data[3] := MakeChar(MyPad);             { how much padding }
    data[4] := Ctl(MyPadChar);              { my padding character }
    data[5] := MakeChar(myEOL);             { my EOL }
    data[6] := MyQuote;                     { my quote char }

    { Handle eight bit quoting parm }
    case RunType of
	Transmit :
	    if EBQState = Binary then
		begin
		    if EBQChar <> DEFEBQUOTE then
			begin
			    data[7] := EBQChar;
			    sentEBQuote := true;
			end
		    else
			data[7] := TYPEY;
		end
	    else
		data[7] := TYPEN;

	Receive :
	    if EBQState = Binary then
		begin
		    if recvdEBQuote then
			data[7] := TYPEY
		    else if needEBQuote then
			data[7] := EBQChar
		    else
			begin
			    EBQState := Ascii;
			    data[7] := TYPEN;
			end;
		end
	    else
		data[7] := TYPEN;
    end;

    SetEBQuoteState;

end;


function CheckEBQuote(    inchr : character;
		      var outchr : character) : EBQtype;
begin
    if (inchr in [EXMARK..RABRACK, GRAVE..TILDE]) then
	begin
	    outchr := inchr;
	    CheckEBQuote := Binary
	end
    else
	CheckEBQuote := Ascii;
end;


procedure DeCodeParm( var data:string); {   decode parameters }
var
    InEBQChar : character;
    i,l : integer;
begin
    DebugMessage('DeCodeParm...       ');
    { Pad with blanks }
    l := lengthSTIP(data);
    IF l < NUMPARAM
      THEN	
	FOR i := l + 1 TO NUMPARAM DO
		data[i] := BLANK;
    data[NUMPARAM+1] := ENDSTR;

    SizeSend := UnChar(data[1]);
    TheirTimeOut := UnChar(data[2]);   { when I should time  out }
    Pad := UnChar(data[3]);            { padding characters  to send  }
    PadChar := Ctl(data[4]);           { padding character }
    SendEOL := UnChar(data[5]);        { EOL to send }
    SendQuote := data[6];              { quote to send }

    { Handle eight bit quoting parm }
    InEBQchar := data[7];
    case RunType of
	Transmit :
	    if EBQState = Binary then
		begin
		    if sentEBQuote then
			begin
			    if InEBQchar <> TYPEY then
				EBQState := Ascii;
			end
		    else if InEBQchar = TYPEN then
			EBQState := Ascii
		    else
			EBQState := CheckEBQuote(InEBQchar, EBQchar);
		end;

	Receive :
	    if EBQState = Binary then
		begin
		    if InEBQchar = TYPEY then
			needEBQuote := true
		    else if InEBQchar = TYPEN then
			EBQState := Ascii
		    else
			begin
			    EBQState := CheckEBQuote(InEBQchar, EBQchar);
			    if EBQState = Binary then
				recvdEBQuote := true;
			end;
		end;
    end;

    SetEBQuoteState;

end;


procedure StartRun; { initialization as necessary }
begin
    DebugMessage('StartRun...         ');
    ClockVMS(startTime);

    NumSendPacks := 0;
    NumRecvPacks := 0;
    NumACK := 0;
    NumNAK := 0;
    NumACKrecv := 0;
    NumNAKrecv := 0;
    NumBADrecv := 0;

    ChInFileRecv := 0;
    ChInFileSend := 0;
    ChInPackRecv := 0;
    ChInPackSend := 0;

    RunTime := 0;

    vmsWritePnt := 0;
    vmsWriteFlg := false;
    FlushTypeAhead(false);
	
    State := Init;              { send  initiate is the start state }
    NumTry := 0;                { say no tries  yet }
end;


procedure OpenPortVMS;

var 
    status : integer;
begin
    vTermSetType := LOCALREMOTE;

    LineIN := REMOTECHAN;
    LineOUT := REMOTECHAN;
    openlist[LINEIN].mode := IOREAD;
    openList[LINEOUT].mode := IOREAD;

    status := ss$_normal;
    SetUpVirtualTerminal(remoteChannel, remReadFunc, remWriteFunc,
			 localChannel, locReadFunc, locWriteFunc,
			 status, vTermSetType, localEcho, parity, lSpeed);
    if (status <> ss$_normal) then
        invalidConnection := true;
end;


procedure VirtualTerminal(var remChanl : integer;
			  var remRFunc : integer;
			  var remWFunc : integer;
			  var locChanl : integer;
			  var locRFunc : integer;
			  var locWFunc : integer;
			  var conStatus : boolean ) ;
fortran;


procedure ConnectVMS;
{ System Dependent connect to remote }
begin
    VirtualTerminal(remoteChannel, remReadFunc, remWriteFunc,
		    localChannel, locReadFunc, locWriteFunc,
		    invalidConnection);
end;


procedure ResetKermitPacketNumber;
begin
    n := 0;
end;


procedure KermitInit;  { initialize various parameters  & defaults }
begin
    DebugMessage('KermitInit...       ');

    Pad := DEFPAD;               { set defaults }
    MyPad := DEFPAD;
    PadChar := DEFPADCHAR;
    MyPadChar := DEFPADCHAR;
    TheirTimeOut := DEFTIMEOUT;
    MyTimeOut := DEFTIMEOUT;
    Delay := DEFDELAY;
    SizeRecv := MAXPACK;
    SizeSend := MAXPACK;
    SendEOL := DEFEOL;
    MyEOL := DEFEOL;
    SendQuote := DEFQUOTE;
    MyQuote := DEFQUOTE;
    EBQChar := DEFEBQUOTE;
    MaxTry := DEFITRY;

    localEcho := oOFF;
    parity := oNONE;
    lSpeed := o4800BAUD;
    fileEol := oCLF;
    transtype := oASCII;
    binascflg := oASCSTATE;
    lastFile := false;
    Local := false;      { default to remote }

    Debug := false;
    debugging := oOFF;
    Runtype := invalid;

    DiskFile := IOERROR;      { to indicate  not open yet }
    LineIN := LOCALCHAN;
    LineOUT := LOCALCHAN;
    ControlIN := STDIN;
    ControlOUT := STDOUT;

    new(ThisPacket);
    new(LastPacket);
    new(CurrentPacket);
    new(NextPacket);
    new(InputPacket);
end;


procedure FinishUp;
{ do any  end of transmission clean up }
begin
    DebugMessage('FinishUp...         ');

    Sclose(DiskFile);

    ClockVMS(endTime);
    if not(noErrors) then
	RunTime := TotalRunTimeVMS(startTime, endTime)
    else
	begin
	    ErrorPack('Aborting Transfer   ');
	    RunTime := 0;
	end;

    oldRunType := RunType;
    lastFile := false;
    PutCf(NEWLINE, ControlOUT);

end;


procedure DebugPacket(    mes : cstring;
			var p : Ppack);
{ Print Debugging Info }
begin
    DebugMessage('DebugPacket...      ');
    PutCon(mes,STDERR);
    with p^ do
	begin
	    PutNum(Unchar(count),STDERR);
	    PutNum(Unchar(seq),STDERR);
	    Putcf(BLANK,STDERR);
	    Putcf(ptype,STDERR);
	    Putcf(NEWLINE,STDERR);
	    PutStr(data,STDERR);
	    Putcf(NEWLINE,STDERR);
	end;
end;


procedure ReSendPacket;
{ re -sends previous packet }
begin
    DebugMessage('ReSendPacket...     ');
    NumSendPacks := NumSendPacks+1;
    if Debug then
	DebugPacket('Re-Sending ...      ',LastPacket);
    PutPacket(LastPacket);
end;


procedure SendPacket;
{ expects count as  length of data portion }
{ and seq as number of packet }
{ builds &  sends packet }

var 
    i,len,chksum : integer;
    temp : Ppack;
begin
    DebugMessage('Sending Packet      ');
    if (NumTry <> 1) and (Runtype = Transmit ) then
	ReSendPacket
    else
	begin
	    with ThisPacket^ do
		begin
		    mark := SOH;               { mark }
		    len := count;             {  save length }
		    count := MakeChar(len+3); {  count = 3+length of data }
		    seq := MakeChar(seq);     {  seq number }
		    chksum := count + seq + ptype;
		    if ( len > 0) then      { is there data ? }
			for i:= 1 to len do
			    if (data[i] >= 0) then
				chksum := chksum + data[i]  { loop for data }
			    else
				chksum := chksum + data[i] + 256;
		    chksum := Checkfunction(chksum);  {  calculate  checksum }
		    data[len+1] := MakeChar(chksum);  {  make printable & output }
		    data[len+2] := SendEOL;           { EOL }
		    data[len+3] := ENDSTR;
		end;

	    NumSendPacks := NumSendPacks+1;
	    if Debug then
		DebugPacket('Sending ...         ',ThisPacket);
	    PutPacket(ThisPacket);

	    if Runtype = Transmit then
		begin
		    temp := LastPacket;
		    LastPacket := ThisPacket;
		    ThisPacket := temp;
		end;
	end;
end;


procedure SendACK(   n:integer); { send ACK  packet }
begin
    DebugMessage('SendAck...          ');
    with ThisPacket^ do
	begin
	    count := 0;
	    seq := n;
	    ptype := TYPEY;
	end;
    SendPacket;
    NumACK := NumACK+1;
end;

procedure SendNAK(   n:integer); { send NAK  packet }
begin
    DebugMessage('SendNAK...          ');
    with ThisPacket^ do
	begin
	    count := 0;
	    seq := n;
	    ptype := TYPEN;
	end;
    SendPacket;
    NumNAK := NumNAK+1;
end;


procedure ErrorPack;
{ output Error packet if remote or print message if local }
var 
  i : integer;
begin
    DebugMessage('ErrorPack...        ');
    with ThisPacket^ do
	begin
	    seq := n;
	    ptype := TYPEE;
	    if local then 	
    	    	CtoS('Kermit:             ',data)
    	    else
		CtoS('Remote Kermit:      ',data);
	    for i := 1 to CONLENGTH do	
		data[CONLENGTH + i] := ord(c[i]);
	    data[CONLENGTH + CONLENGTH + 1] := ENDSTR;
	    count := LengthSTIP(data);

	    if local then 
		begin
		   putstr(data,STDERR);
		   putcf(NEWLINE,STDERR);
		end	
    	    else
		SendPacket;
	end;
end;


procedure PutErr( c:cstring);
{ Print error_messages }
begin
    DebugMessage('PutErr...           ');
    if Local then
	Putcln(c,STDERR);
end;


procedure Field1; { Count }

var 
    test: boolean;
begin
    DebugMessage('Field1...           ');
    with NextPacket^ do
	begin
	    InputPacket^.count := t;
	    count := UnChar(t);
	    test := (count >= 3) or (count <= SizeRecv-2);
	    if not test then
		DebugMessage('Bad count           ');
	    isgood := isgood and test;
	end;
end;


procedure Field2; { Packet Number }

var 
    test : boolean;
begin
    DebugMessage('Field2...           ');
    with NextPacket^ do
	begin
	    InputPacket^.seq := t;
	    seq := UnChar(t);
	    test := (seq >= 0) or (seq <= 63);
	    if not test then
		DebugMessage('Bad seq number      ');
	    isgood := isgood and test;
	end;
end;


procedure Field3; { Packet type }

var 
    test : boolean;
begin
    DebugMessage('Field3...           ');
    with NextPacket^ do
	begin
	    ptype := t;
	    InputPacket^.ptype := t;

	    test := (t =TYPEB) or (t=TYPED) or (t=TYPEE) or (t=TYPEF)
		    or (t=TYPEN) or (t=TYPES) or (t=TYPEY) or (t=TYPEZ);
	    if not test then
		DebugMessage('Bad Packet type     ');
	    isgood := isgood and test;
	end;
end;


procedure ProcessQuoted; { for data }
begin
    with NextPacket^ do
	begin
	    if (t = MyQuote) or ((t = EBQchar) and (EBQState = Binary)) then
		begin
		    if control then
			begin
			    data[dataptr] := t + ishigh;
			    dataptr := dataptr + 1;
			    control := false;
			    ishigh := 0;
			end
		    else if (t = MyQuote) then { Set Control on }
			control := true;
		end
	    else if control then
		begin
		    data[dataptr] := ctl(t) + ishigh;
		    dataptr := dataptr + 1;
		    control := false;
		    ishigh := 0;
		end
	    else
		begin
		    data[dataptr] := t + ishigh;
		    dataptr := dataptr + 1;
		    ishigh := 0;
		end;
	end;
end;


procedure Field4; { Data }
begin
    PacketPtr := PacketPtr+1;
    InputPacket^.data[PacketPtr] := t;

    with NextPacket^ do
	begin
	    if ((pType = TYPES) or (pType = TYPEY)) then
		begin
		    data[dataptr] := t;
		    dataptr := dataptr+1;
		end
	    else
		begin
		    if (EBQstate = Binary) then
			begin { Has it been quoted }
			    if (not(control) and (t = EBQchar)) then
				ishigh := 128
			    else
				ProcessQuoted;
			end
		    else
			ProcessQuoted;
		end;
	end;
end;


procedure Field5; { Check Sum }

var 
    test : boolean;
begin
    DebugMessage('Field5...           ');
    with InputPacket^ do
	begin
	    PacketPtr := PacketPtr +1;
	    data[PacketPtr] := t;
	    PacketPtr := PacketPtr +1;
	    data[PacketPtr] := ENDSTR;
	end;
    {  end of input string }
    check := Checkfunction(check);
    check := MakeChar(check);
    test := (t=check);
    if not test then
	DebugMessNumb('Bad CheckSum=       ', check);
    isgood := isgood and test;
    NextPacket^.data[dataptr] := ENDSTR;
    {  end of data string }
    finished := true;  { set finished }
end;


procedure BuildPacket;
{ receive packet &  validate checksum }

var 
    temp : Ppack;
begin
    with NextPacket^ do
	begin
	    if restart then
		begin
		    { read until get SOH marker }
		    if  (t = SOH) then
			begin
			    finished := false;    { set varibles }
			    control := false;
			    ishigh := 0;	  { no shift }
			    isgood := true;
			    seq := -1;       { set return values to  bad packet }
			    ptype := QUESTION;
			    data[1] := ENDSTR;
			    data[MAXSTR] := ENDSTR;
			    restart := false;
			    fld := 0;
			    dataptr := 1;
			    PacketPtr := 0;
			    check := 0;
			end;
		end
	    else                          { have started packet  }
		begin
		    if (t=SOH) then
			restart := true
		    else if (t=myEOL) then
			begin
			    finished := true;
			    isgood := false;
			end
		    else
			begin
			    case fld of
				{ increment  field number }
				0:   fld := 1;
				1:   fld := 2;
				2:   fld := 3;
				3: 
				    if (count=3) then
					fld := 5
				    else
				        fld := 4;
				4: 
				    if (PacketPtr>=count-3) then
					fld := 5;
			    end { case };

			    if (fld<>5) then
				{ add into checksum }
				    check := check+t;

			    case fld of
				1:      Field1;
				2:      Field2;
				3:      Field3;
				4:      Field4;
				5:      Field5;
			    end; { case }
			end;
		end;

	if finished then
	    begin
		if (ptype=TYPEE)  and isgood then   { error_packets }
		    begin
			if Local then
			    PutStr(data,STDERR);
			Putcf(NEWLINE,STDERR);
			FinishUp(true);
			ProgramHalt;
		    end;
		NumRecvPacks := NumRecvPacks+1;
		if Debug then
		    begin
			DebugPacket('Received ...        ',InputPacket);
			if isgood then
			    PutCln('Is Good             ',STDERR);
		    end;
		temp := CurrentPacket;
		CurrentPacket := NextPacket;
		NextPacket := temp;
	end;
    end;
end;


function ReceivePacket: boolean;
begin
    DebugMessage('ReceivePacket...    ');
    finished := false;
    restart := true;
    FromConsole := nothing;  { No Interupt }

    {  Obtain packet from VMS incoming channel }
    vmsChRead := GetVMSPacket(LineIn);

    {  Check local terminal for abort, resend character }
    if local then
	begin
	    CheckTypeAhead(FromConsole);
	    case FromConsole of
		abortnow: 
		   begin
			FinishUp(true);
			ProgramHalt;
		   end;
		nothing:        { nothing };
		CRin: 
		    begin
			t := MyEOL;
			FromConsole := nothing;
		    end;
	    end;
	end;

    if (vmsChRead = 0) then
	begin
	    ReceivePacket := false;
	    if (timeOutStatus) then
		begin
		    CurrentPacket^.ptype := TYPET;
		    restart := true;
		    if (local) then
			PutCln('Timed Out           ', STDERR)
		end;
	end
    else
	begin
	    repeat
		t := GetIn;

		if (t<>ENDOFQIO) then
		    BuildPacket
		else
		    begin
			finished := true;
			isgood := false;
		    end;
	    until finished;

	    ReceivePacket := isgood;
	end;
end;


function ReceiveACK :    boolean;
{ receive ACK with  correct number }

var 
    Ok: boolean;
begin
    DebugMessage('ReceiveACK...       ');
    Ok := ReceivePacket;
    with CurrentPacket^ do
	begin
	    if (ptype=TYPEY) then
		NumACKrecv := NumACKrecv+1
	    else if (ptype=TYPEN) then
		NumNAKrecv := NumNAKrecv+1
	    else
		NumBadrecv := NumBadrecv +1;
	    { got right  one ? }
	    ReceiveACK := ( Ok and (ptype=TYPEY) and (n=seq))
	end;
end;


procedure GetData(   var newstate:KermitStates);
{ get data from file into ThisPacket }

var 
    { and return next state - data &  EOF }
    x,c : character;
    i: integer;
begin
    DebugMessage('GetData...          ');
    if (NumTry=1) then
	begin
	    i := 1;
	    x := ENDSTR;
	    with ThisPacket^ do
		begin
		    while (i< SizeSend - 8 ) and (x <> ENDFILE) do
			{ leave room for quote  & NEWLINE }
			begin
			    x := Getcf(c,DiskFile);
			    if (x<>ENDFILE) then
			        begin
				    if (x > DEL) then
				       begin
					ErrorPack('Non-ASCII text char ');
					FinishUp(true);
					ProgramHalt;
				       end;	
				    if (x < NULL) then
				        case EBQstate of
				   	    ascii :
						begin	
						  ErrorPack('No Binary Support   ');
						  FinishUp(true);
						  ProgramHalt;
						end;
					    binary : 
						begin
						    data[i] := EBQchar;
						    i := i + 1;
						    x := x + 128;
						end;
					end;

				    if (IsControl(x)) or (x=SendQuote) or 
					((x = EBQchar) and (EBQState = Binary)) then
					begin	      { control char -- quote }
					    if ((x=NEWLINE) and
						 (EBQState <> Binary)) then 
						case EOLFORFILE of
						    LineFeed:   { ok as  is };
						    CrLf: 
							begin
							    data[i] := SendQuote;
							    i := i+1;
							    data[i] := Ctl(CR);
							    i := i+1;
							    { LF  will sent below }
							end;
						    JustCR:
							x := CR;
						end { case };
					    data[i] := SendQuote;
					    i := i+1;
					    { V1.1D next line should be 'and' }
					    if (x<>SendQuote) and (x <> EBQchar) then
						data[i] := Ctl(x)
					    else
						data[i] := x;
					end
				    else               { regular char }
					data[i] := x;
				end;

			    if (x<>ENDFILE) then
				begin
				    i := i+1;    { increase  count for next char }
				    AddTo(ChInFileSend,1);
				end;
			end;

		    data[i] := ENDSTR;   { to terminate  string }

		    count := i -1;       { length }
		    seq := n;
		    ptype := TYPED;

		    if (x=ENDFILE) then
			begin
			    newstate := EOFile;
			    Sclose(DiskFile);
			end
		    else
			newstate := FileData;
		SaveState := newstate;        { save state }
	    end
	end
    else
	newstate := SaveState;        {  get old state }
end;


function GetFileVMS(    fileName : string80;
		    var newFileName : string;
		    var nextFilePnt : integer;
		    var lastFile : boolean) : boolean;
{  Routine to get a new file from VMS }

var 
    vmsFileIn, vmsFileRes : varying[80] of char;
    stat, i, j, lenStr, tempPnt : integer;
    tempFile : cstring;

begin
    vmsFileIn := fileName;
    tempPnt := nextFilePnt;
    stat := $Find_File(fileName := vmsFileIn,
		       resultName := vmsFileRes,
		       context := tempPnt);
    nextFilePnt := tempPnt;
    if ((stat <> rms$_normal) or (lastFile)) then
	begin
	    if (stat = rms$_fnf) and (RunType <> Receive) then
 		PutErr('VMS - File Not Found')
	    else if (stat = rms$_typ) then
		PutErr('VMS - File Type Err ')
	    else if (stat <> rms$_normal) and (stat <> rms$_nmf) and
		    (RunType <> Receive) then
		PutErr('VMS - RMS file Error');
	    GetFileVMS := false;
	    lastFile := true;
	end
    else
	begin
	    i := index(vmsFileRes,']');
	    lenStr := length(vmsFileRes) - i;
  	    vmsFileRes := substr(vmsFileRes, i+1, lenStr);
	    i := index(vmsFileRes, ';');
	    vmsFileRes := substr(vmsFileRes, 1, i-1);
	    tempFile := vmsFileRes;
	    for j:=(length(vmsFileRes) + 1) to CONLENGTH do
		tempFile[j] := ' ';
	    CtoS(tempFile, newFileName);
	    newFilename[i] := ENDSTR;	{ Shorten to correct file length }
	    GetFileVMS := true;
	end;
end;


function GetNextFile:    boolean;
{ get next  file to send in ThisPacket }
{ returns true if no more }

var 
    result: boolean;
begin
    DebugMessage('GetNextFile...      ');
    result := true;
    if (NumTry=1) then
	with ThisPacket^ do
	    begin
		if GetFileVMS(fileSpec, data, vmsFilePnt, lastFile) then
		    begin            { open file  }
			DiskFile := Sopen(data,IOREAD*binascflg);
			if DiskFile = IOERROR then
			    begin
				ErrorPack('Cannot open file    ');
				FinishUp(true);
				ProgramHalt;
			    end;
			count := LengthSTIP(data);
			AddTo(ChInFileSend , count);
			seq := n;
			ptype := TYPEF;
			result := false;
		    end;
	    end
	else
	    result := false; { for saved packet  }
    GetNextFile := result;
end;


procedure SendFile; { send file name  packet }
begin
    DebugMessage('SendFile...         ');
    if NumTry > MaxTry then
	begin
	    PutErr ('Send file - Too Many');
	    State := Abort;      { too many tries, abort }
	end
    else
	begin
	    NumTry := NumTry+1;
	    if GetNextFile then
		begin
		    State := Break;
		    NumTry := 0;
		end
	    else
		begin
		    if ((NumTry = 1) and (local)) then
			PutCs('Sending File...     ',
				    ThisPacket^.data, controlOUT);
		    if debug then
			begin
			    if (NumTry = 1) then
				PutStr(ThisPacket^.data,STDERR)
			    else
				PutStr(LastPacket^.data,STDERR);
			    Putcf(NEWLINE,STDERR);
			end;
		    SendPacket;     { send this packet }
		    if ReceiveACK then
			begin
			    State := FileData;
			    NumTry := 0;
			    n := (n+1) MOD 64;
			end
		end;
	end;
end;


procedure SendData;  { send file data packets }

var 
    newstate: KermitStates;
begin
    DebugMessage('SendData...         ');
    if debug then
	PutCN ( 'Sending data        ',n,STDERR);
    if NumTry > MaxTry then
	begin
	    State := Abort;       { too  many tries, abort }
	    PutErr ('Send data - Too many');
	end
    else
	begin
	    NumTry := NumTry+1;
	    GetData(newstate);
	    SendPacket;
	    if ReceiveACK then
		begin
		    State := newstate;
		    NumTry := 0;
		    n := (n+1) MOD 64;
		end
	end;
end;


procedure SendEOF;    { send  EOF  packet }
begin
    DebugMessage('SendEOF...          ');
    if NumTry > MaxTry then
	begin
	    State := Abort;       { too  many tries, abort }
	    PutErr('Send EOF - Too Many ');
	end
    else
	begin
	    NumTry := NumTry+1;
	    if (NumTry = 1) then
		begin
		    with ThisPacket^ do
			begin
			    ptype := TYPEZ;
			    seq := n;
			    count := 0;
			end;
		    Sclose(DiskFile);
		end;
	    SendPacket;
	    if ReceiveACK then
		begin
		    State := FileHeader;
		    NumTry := 0;
		    n := (n+1) MOD 64;
		end
	end;
end;


procedure SendBreak; { send break packet }
begin
    DebugMessage ('Sending break       ');
    if NumTry > MaxTry then
	begin
	    State := Abort;       { too  many tries, abort }
	    PutErr('Send break -Too Many');
	end
    else
	begin
	    NumTry := NumTry+1;
	    { make up packet  }
	    if NumTry = 1 then
		begin
		    with ThisPacket^ do
			begin
			    ptype := TYPEB;
			    seq := n;
			    count := 0;
			end
		end;
	    SendPacket; { send this packet }
	    if ReceiveACK then
		State := Complete;
	end;
end;


procedure SendInit;  { send init packet }
begin
    DebugMessage ('Sending init        ');
    if NumTry > MaxTry then
	begin
	    State := Abort;      { too many tries, abort }
	    PutErr('Cannot Initialize   ');
	end
    else
	begin
	    NumTry := NumTry+1;
	    if (NumTry = 1) then
		begin
		    with ThisPacket^ do
			begin
			    EnCodeParm(data);
			    count := NUMPARAM;
			    seq := n;
			    ptype := TYPES;
			end
		end;

	    SendPacket; { send this packet }
	    if (NumTry = 1) then { Flush to prevent pile up of NAK's }
		FlushTypeAhead(true);
	    if ReceiveACK then
		begin
		     with CurrentPacket^ do
			 begin
			     SizeSend := UnChar(data[1]);
			     TheirTimeOut := UnChar(data[2]);
			     Pad := UnChar(data[3]);
			     PadChar := Ctl(data[4]);
			     SendEOL := CR;  { default to CR  }
			     if (LengthSTIP(data) >= 5) then
				if (data[5] <> 0) then
				    SendEOL := UnChar(data[5]);
				SendQuote := SHARP;  { default # }
				if (LengthSTIP(data) >= 6) then
				    if (data[6] <> 0) then
					SendQuote := data[6];
			end;

		    State := FileHeader;
		    NumTry := 0;
		    MaxTry := DEFTRY;  { use regular default now  }
		    n := (n+1) MOD 64;
	      end;
	end;
    FlushTypeAhead(false);
end;


procedure SendSwitch;
{ Send-switch is the state  table switcher for sending files.
* It loops until either it is finished or a fault is encountered.
* Routines called by sendswitch are responsible for changing the state. }

begin
    DebugMessage ('Send Switch         ');
    SleepVMS(Delay);
    StartRun;
    repeat
	case State of
	    FileData:     SendData;         { data-send state }
	    FileHeader:   SENDFILE;         { send file name }
	    EOFile:       SendEOF;          { send end-of-file }
	    Init:         SendInit;         { send initialize }
	    Break:        SendBreak;        { send break }
	    Complete:     {  nothing };
	    Abort:        {  nothing };
	end { case };
    until ( (State = Abort) or (State=Complete) );
end;


procedure GetFile(   data:string);
{ create file from  fileheader packet }

const 
    { used  for GetFile }
      FLEN1 = 10;
      FLEN2 = 13;
      EXTLEN = 3;

var 
    p, strend, i, j, periodCnt : integer;
    temp : string;
begin
    DebugMessage ('GetFile...          ');
    with CurrentPacket^ do
	begin
	    if DiskFile = IOERROR then
		begin
		    i := 1;
		    j := 1;
		    periodCnt := 0;
		    repeat
		        if (data[i] in [LETA..LETZ, LETsa..LETsz,
					    LET0..LET9, PERIOD]) then
			    begin
				temp[j] := data[i];
				if data[i] = PERIOD then
				    begin
					p := j;
					periodCnt := periodCnt + 1;
				    end
			    end
		        else
			    begin
			        temp[j] := j + LET0;
				if not (temp[j] in [LET0..LET9]) then
				    temp[j] := LET0;
			    end;
		        i := i + 1;
		        j := j + 1;
		    until (data[i] = ENDSTR);

		    temp[j] := ENDSTR;
		    j := j - 1;
			    
		    {  check position of '.' -- truncate if bad }
		    if periodCnt = 2 then
			begin
			    temp[p] := ENDSTR;
			    p := IndexSTIP(temp,PERIOD);
			end;

		    if (p > FLEN1 ) then
		        begin
		            temp[FLEN1] := PERIOD;
			    temp[p] := (p mod 10) + LET0;
			    p := FLEN1;
		        end;

		    {  check Max length }
		    if j > FLEN2 then
			begin
		            temp[FLEN2 +1] := ENDSTR;
			    j := FLEN2;
			end;

		    if (j >= FLEN1) then
			begin
		            if ((j-p) > EXTLEN) then
				if (p <> NULL) then
				    begin
			            	temp[p +EXTLEN+1] := PERIOD;
					temp[p +EXTLEN+2] := ENDSTR;
				    end
				else
				    temp[j - EXTLEN] := PERIOD;
			end
		    else
			begin
			    temp[j +1] := PERIOD;
			    temp[j +2] := ENDSTR;
			end;

		    if Exists(temp) then
			if (local) or (debug) then
			    PutCS('File already exists ',temp,
						      STDERR);

		    if (local) or (debug) then
		        PutCS('Creating...         ',temp,STDERR);

		    DiskFile := Sopen(temp,IOWRITE*binascflg);
	        end;

	if (Diskfile = IOERROR) then
	    begin
		FinishUp(true);
		ProgramHalt;
	    end;
    end;
end;


procedure ReceiveInit;
{ receive init packet }
{ respond with ACK  and  our parameters }

var 
	receiveStat : boolean;
begin
    DebugMessage ('ReceiveInit...      ');
    if NumTry > MaxTry then
	begin
	    State := Abort;
	    PutErr('Cannot receive init ');
	end
    else
	begin
	    NumTry := NumTry+1;
	    receiveStat := ReceivePacket;
	    if (ReceiveStat and (CurrentPacket^.ptype = TYPES)) then
		begin
		    n := CurrentPacket^.seq;
		    DeCodeParm(InputPacket^.data);
		    {  now send mine }
		    with ThisPacket^ do
			begin
			    count := NUMPARAM;
			    seq := n;
			    Ptype := TYPEY;
			    EnCodeParm(data);
			end;
		    SendPacket;

		    NumACK := NumACK+1;
		    State := FileHeader;
		    OldTry := NumTry;
		    NumTry := 0;
		    MaxTry := DEFTRY; { use  regular default now }
		    n := (n+1) MOD 64
		end
	    else
		begin
		    if Debug then
			PutCln('Received Bad init   ',STDERR);
		    SendNAK(n);
		end;
	end;
end;


procedure DataToFile; { output to file }

var 
    len,i : integer;
    temp : string;
begin
    DebugMessage ('DataToFile...       ');
    with CurrentPacket^ do
	begin
	    len := LengthSTIP(data);
	    AddTo(ChInFileRecv ,len);
	    if (EBQState <> Binary) then
		case EOLFORFILE of
		    LineFeed:
			PutStr(data,DiskFile);
		    CrLf: 
		        begin  { output CR only if next is not LF }
			    for i:=1 to len do
				if data[i] = CR then
				   begin
				     if data[i+1] <> NEWLINE then
					   Putcf(data[i],DiskFile);
				   end
				else
				   Putcf(data[i],DiskFile);
			end;
		    JustCR: 
			begin   { change CR  to NEWLINE }
			    for i:=1 to len do
				if data[i]=CR then
				    data[i] := NEWLINE;
			    PutStr(data,DiskFile);
			end;
		end
	    else
	        PutStr(data, DiskFile);
	end;
end;


procedure dodata;  {  Process Data packet }
begin
    DebugMessage ('DoData...           ');
    with CurrentPacket^ do
	begin
	    if  seq = ((n + 63) MOD 64) then
		begin                { data last one }
		    if OldTry>MaxTry then
			begin
			    State := Abort;
			    PutErr('Old data - Too many ');
			end
		    else
			 begin
			     SendACK(seq);
			     NumTry := 0;
			 end;
		 end
	     else
		 begin            { data  - this one }
		    if (n<>seq) then
			SendNAK(n)
		    else
			begin
			DataToFile;
			SendACK(n); { ACK }
			OldTry := NumTry;
			NumTry := 0;
			n := (n+1) MOD 64;
		    end;
		end;
	 end;
end;

procedure doFileLast;   { Process File Packet }
begin          { File header - last  one  }
    DebugMessage ('DoFileLast...       ');
    if OldTry > MaxTry { tries ? } then
	begin
	    State := Abort;
	    PutErr('Old file - Too many ');
	end
    else
	begin
	    OldTry := OldTry+1;
	    with CurrentPacket^ do
		begin
		    if seq = ((n + 63) MOD 64) then
		        {  packet number }
			begin  { send ACK }
			    SendACK(seq);
			    NumTry := 0
			end
		    else
			begin
			    SendNAK(n);   {  NAK }
			end;
		end;
	end;
end;


procedure DoEOF;  { Process EOF packet }
begin                 { EOF  - this one }
    DebugMessage ('DoEOF...            ');
    if CurrentPacket^.seq<>n then   { packet number ? }
	SendNAK(n) { NAK }
    else
	begin               { send ACK }
	    TransferOK := true; { Set true before calling Sclose }	
	    Sclose(DiskFile);  { close file }
	    SendACK(n);
	    OldTry := NumTry;
	    NumTry := 0;
	    n := (n+1) MOD 64; { next packet  }
	    State := FileHeader;   { change state }
	end;
end;


procedure ReceiveData;  { Receive data packets }

var 
    strend: integer;
    good : boolean;

begin
    DebugMessage ('ReceiveData...      ');
    if NumTry > MaxTry then          { check number of tries }
	begin
	    State := Abort;
	    if local then
		PutCN('Recv data -Too many ',n,STDERR);
	end
    else
	begin
	    NumTry := NumTry+1;                { increase number of tries }
	    good := ReceivePacket;        { get  packet }
	    with CurrentPacket^ do
	        begin
	    	    if debug then
			PutCN('Receiving (Data)    ',CurrentPacket^.seq,STDERR);
		    if ((ptype = TYPED) or (ptype=TYPEZ)
			   or (ptype=TYPEF)) and good then     { check type }
			case ptype of
			    TYPED:  doData;
			    TYPEF:  doFileLast;
			    TYPEZ:  doEOF;
			end { case }
		    else
			begin
			    if Debug then
				PutCln('Expected data pack  ',STDERR);
			    SendNAK(n);
			end;
		end;
	end;
end;


procedure doBreak; {  Process Break packet }
begin                    { Break transmission }
    DebugMessage ('DoBreak...          ');
    if CurrentPacket^.seq<>n then    { packet number ? }
        SendNAK(n) { NAK }
    else
        begin            { send   ACK }
  	    SendACK(n) ;
	    State := Complete  { change  state }
	end;
end;


procedure DoFile; { Process file packet }
begin                 { File Header  }
    DebugMessage ('DoFile...           ');
    with CurrentPacket^ do
	begin
	    if seq<>n then           { packet number ? }
		SendNAK(n)  { NAK }
	    else
		begin               { send ACK }
		    AddTo(ChInFileRecv, LengthSTIP(data));
	  	    GetFile(data);   { get file  name }
		    TransferOK := false; 	
	  	    SendACK(n);
		    OldTry := NumTry;
		    NumTry := 0;
		    n := (n+1) MOD 64; { next packet  }
		    State := FileData;   { change state  }
		end;
	end;
end;


procedure DoEOFLast; { Process EOF Packet }
begin               { end of File Last One}
    DebugMessage ('DoEOFLast...        ');
    if OldTry > MaxTry then
	begin
	    State := Abort;
	    PutErr('Old EOF - Too many  ');
	end
    else
	begin
	    OldTry := OldTry+1;
	    with CurrentPacket^ do
		begin
 		    if seq =((n + 63 ) MOD 64) then
			{  packet number }
			begin  { send ACK }
			    SendACK(seq);
			    Numtry := 0
			end
		    else
		 	begin
			    SendNAK(n);  { NAK }
			end
		end;
	end;
end;


procedure DoInitLast;
begin                { Init  Packet - last one }
    DebugMessage ('DoInitLast...       ');
    if OldTry> DEFITRY then
	begin
	    State := Abort;
	    PutErr('Old init - Too many ');
	end
    else
	begin
	    OldTry := OldTry+1;
	    if CurrentPacket^.seq = ((n + 63) MOD  64) then
		    { packet number }
		begin   { send ACK }
		    with ThisPacket^ do
			begin
			    count := NUMPARAM;
			    seq := CurrentPacket^.seq;
			    ptype := TYPEY;
			    EnCodeParm(data);
			end;
		    SendPacket;
		    NumACK := NumACK+1;
		    NumTry := 0;
		end
	    else
		begin
		    SendNAK(n);  { NAK }
		end;
	end;
 end;


procedure ReceiveFile; { receive file packet  }

var 
    good: boolean;

begin
    DebugMessage ('ReceiveFile...      ');
    if NumTry > MaxTry then          { check number of tries }
	begin
	    State := Abort;
	    PutErr('Recv file - Too many');
	end
    else
	begin
	    NumTry := NumTry+1;                { increase number of tries }
	    good := ReceivePacket;             { get packet }
	    with CurrentPacket^ do
	        begin
	  	    if debug then
			PutCN('Receiving (File)    ',seq,STDERR);
		    if ((ptype = TYPES) or (ptype=TYPEZ)
			   or (ptype=TYPEF) or (ptype=TYPEB)) { check type }
			   and good then
			case ptype of
			    TYPES:  doInitLast;
			    TYPEZ:  doEOFLast;
			    TYPEF:  doFile;
			    TYPEB:  doBreak;
			end { case }
		    else
			begin
			    if Debug then
				PutCln('Expected File Pack  ',STDERR);
			    SendNAK(n);
			end;
		end;
	end;
end;


procedure RecvSwitch; { this procedure  is the main receive routine }
begin
    DebugMessage ('RecvSwitch...       ');
    StartRun;
    repeat
	case State of
	    FileData:       ReceiveData;
	    Init:           ReceiveInit;
	    Break:          {  nothing };
	    FileHeader:     ReceiveFile;
	    EOFile:         {  nothing };
	    Complete:       {  nothing };
	    Abort:          {  nothing };
	end;
    {  case }
    until (State = Abort ) or ( State = Complete );
end;


procedure KermitMain; { Main  procedure }

var 
    aline : string;
    j : integer;
    errorOccurred : boolean;
begin

    DebugMessage ('KermitMain...       ');

    errorOccurred := false;
    case Runtype of
	Receive: 
	    begin { filename is optional here }
		if (rFileSpec = oON) then
		    begin
			CopyStringVMS(fileSpec, aline);
			if ((Exists(aline)) and (local)) then
			    PutCS('Overwriting         ',aline,STDERR);
			DiskFile := Sopen(aline, IOWRITE*binascflg);
			if (DiskFile = IOERROR) then
			    begin
				PutErr('Cannot Open File    ');
				errorOccurred := true;
			    end
			else
			    if (local) then
				PutCS('Receiving File...   ',
					       aline, ControlOUT);
			rFileSpec := oOFF;
		    end;

		if not(errorOccurred) then
		    RecvSwitch;
	    end;
	Transmit: 
	    SendSwitch;

	Invalid:        { nothing };
    end; {  case }

    FinishUp(errorOccurred); { end  of program }

end { main   };

{  Include the parser into kermit. }
%include   'kermdir:parser.pas/list'

begin

    ctrlOff := LIB$M_CLI_CTRLY;
    stat := $Disable_ctrl(ctrlOff);

    SetUpExitHandlerVMS(1, 6);   { VMS dependent routine }

    Greeting;

    KermitInit;       { initialize }

    initio;

    9999: { Goto for an error packet }

    RunType := Invalid;

    while not(exitProgram) do
	begin

	    PromptAndParseUser(exitProgram, RunType);

	    if not(exitProgram) then
		begin
		    ResetKermitPacketNumber;
		    case RunType of
			Receive,
			Transmit : 
			    if not(invalidConnection) then
				KermitMain
			    else
				BadVTerminalConnect;
			Connect : 
			    begin
				local := true;
				OpenPortVMS;
				if not(invalidConnection) then
				    ConnectVMS
				else
				    BadVTerminalConnect;
			    end;
		    end;
		end;
	    RunType := Invalid;
	end;

	SetUpExitHandlerVMS(0, 4);   { VMS dependent routine }

	stat := $Enable_Ctrl(ctrlOff);

end.