Columbia Kermit/kermit.zip/honeywellcp6b/hcp6.pas

Pascal/Delphi Source File | 2020-01-01 | 131KB | 4,396 lines

!JOB NAME=KERMIT
!PASCAL ME OVER KERMIT_OBJ (NDB,LS)
{
Program Kermit implements the KERMIT protocol under HONEYWELL/CP6.

Authors:   Philip Murton - original RT-11 pascal program.
           Bruce W. Pinn - modified version for VAX/VMS.
           Douglas Vaughan, Cheryl Poostay, Kevin Asplen, Jay Undercoffler
                         - modified VAX/VMS version for HONEYWELL/CP6.

Date:  March 27, 1985

Site:  Bucknell University Computing Services
       Lewisburg, Pennsylvania 17837
       [phone]
}
program Kermit(input,output,LINE,ERRORS,DiskOutFile,DiskInFile);

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

     {%INCLUDE 'CURRENT_GLOBAL'(lines 22-102)}
{label
      9999; }             { used only to simulate a "halt"  instruction }

const


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


    { universal manifest constants  }
      NULL = 0;
      ENDSTR =    -1 ;       { null-terminated strings }
      ENDFILE =   -2 ;
      ENDOFQIO =  -3 ;
      MAXSTR = 100;       { longest possible string }
      CONLENGTH = 20;

    { 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 }
      DEFDELAY = 10 ;    { 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;


      LineInSize = 512;

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

    { %include   'CURRENT_CONSTANT' (lines 105-395)}
   NULLTOKE = 100;
   RANGENULL = 101;
        KERMITPROMPT = 'Kermit-CP6>';
        KERMITHELP = 'KERMITHLP:';

   INVALIDCOMMAND = 1;
   INVALIDSETCOMMAND = 2;
   INVALIDSHOWCOMMAND = 3;
   NOTIMPLEMENTED = 4;
   INVALIDFILESPEC = 5;
   INVALIDSETCVALUE =  6;
   INVALIDSETDVALUE =  7;
   INVALIDSETOVALUE = 8;
   INVALIDSETRANGE = 9;
        SENDPARMS = 10;
        RECEIVEPARMS = 11;
        LOCALPARMS = 12;
        BLANKLINE = 13;
        NOHELPAVAILABLE = 14;
   IBEXSPAWNFAILED = 15;

   cSET        = 'SET          ';
   cSHOW       = 'SHOW         ';
   cSTATUS     = 'STATUS       ';
   cCONNECT    = 'CONNECT      ';
   cHELP       = 'HELP         ';
   cEXIT       = 'EXIT         ';
   cQUIT       = 'QUIT         ';
   cQUESTION   = '?            ';
   cSEND       = 'SEND         ';
   cRECEIVE    = 'RECEIVE      ';
   cDEBUGGING  = 'DEBUGGING    ';
   cLOCALECHO  = 'LOCAL-ECHO   ';
   cDELAY      = 'DELAY        ';
   cPACKETLENGTH   = 'PACKET-LENGTH';
   cPADDING    = 'PADDING      ';
   cPADCHAR    = 'PADCHAR      ';
   cTIMEOUT    = 'TIMEOUT      ';
   cENDOFLINE  = 'END-OF-LINE  ';
   cQUOTE      = 'QUOTE        ';
   cALL        = 'ALL          ';
   cON     = 'ON           ';
   cOFF        = 'OFF          ';
        cBADTOKEN       = 'XX           ';
   cTRANSMODE  = 'TRANSMODE    ';
   cASCII      = 'ASCII        ';
   cBINARY     = 'BINARY       ';
   cEIGHTQUOTE = 'EIGHT-QUOTE  ';
        cFILERECORD     = 'FILERECORD   ';
        cCR        = 'CR           ';
        cLF        = 'LF           ';
        cCRLF      = 'CRLF         ';
   cPARITY     = 'PARITY       ';
   cEVEN       = 'EVEN         ';
   cODD        = 'ODD          ';
   cNONE       = 'NONE         ';
   cSPEED      = 'SPEED        ';
   cIBEX        = 'IBEX         ';

   uSET = 3;
   uMSEND = 3;
   uMRECEIVE = 1;
   uSHOW = 2;
   uSTATUS = 2;
   uCONNECT = 1;
   uIBEX = 1;
   uHELP = 1;
   uQUESTION = 1;
   uEXIT = 1;
   uQUIT = 1;
   uSEND = 1;
   uRECEIVE = 1;
   uDEBUGGING = 3;
        uFILERECORD = 1;
   uTRANSMODE = 1;
   uLOCALECHO = 2;
   uDELAY = 3;
   uPACKETLENGTH = 3;
   uPADDING = 4;
   uPADCHAR = 4;
   uTIMEOUT = 1;
   uENDOFLINE = 1;
   uQUOTE = 1;
   uALL = 1;
   uON = 2;
   uOFF = 2;
        uBADTOKEN = 1;
        uCR = 2;
        uLF = 1;
        uCRLF = 2;
   uPARITY = 1;
   uEVEN = 1;
   uODD = 1;
   uNONE = 1;
   uSPEED = 2;
   uASCII = 1;
   uBINARY = 1;
   uQUOTED = 1;
   uEIGHTQUOTE = 1;

   oON = 0;
   oOFF = 1;
   oEVEN = 2;
   oODD = 3;
   oNONE = 4;
   oSET = 5;
   oSHOW = 6;
   oSTATUS = 7;
   oCONNECT = 8;
   oHELP = 9;
   oEXIT = 10;
   oQUIT = 11;
   oSEND = 12;
   oRECEIVE = 13;
   oDEBUGGING = 14;
   oLOCALECHO = 15;
   oDELAY = 16;
   oPACKETLENGTH = 17;
   oPADDING = 18;
   oPADCHAR = 19;
   oTIMEOUT = 20;
   oENDOFLINE = 21;
   oQUOTE = 22;
   oQUESTIONM = 23;
   oALL = 24;
        oBADTOKEN = 25;
        oFILERECORD = 26;
        oCR = 27;
        oLF = 28;
        oCRLF = 29;
   oPARITY = 30;
   oSPEED = 31;
   oIBEX = 32;
   oTRANSMODE = 33;
   oASCII = 34;
   oBINARY = 35;
   oEIGHTQUOTE = 36;
   oXXXX = 100 ;

   oMAINTYPE = 1;
   oSETTYPE = 2;
   oSHOWTYPE = 3;
   oSENDTYPE = 4;
   oRECEIVETYPE = 5;
   oDEBUGTYPE = 6;
        oFILERECTYPE = 8;
   oLOCECHOTYPE = 9;
   oPARITYTYPE = 10;
   oTRANSTYPE = 11;

   DECIMAL = 0;
   SDECIMAL = 1;
   OCTAL = 2;
   CHRACTER = 3;
   IDECIMAL = 4;
   EBCHRACTER = 5;

   oASCSTATE = 1;
   oBINSTATE = 0;

   o300BAUD = 300;
   o600BAUD = 600;
   o1200BAUD = 1200;
   o2400BAUD = 2400;
   o4800BAUD = 4800;
   o9600BAUD = 9600;

type
     character = ENDOFQIO..255;     { 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;
     IOstate = IOERROR..IOWRITE;
     filedesc = (keyboard,screen,RS232,history,outfile,infile) ;

    IOBUFFER = packed array[1..LineInSize] of character ;
    { Eight bit file stuff }
     EBQtype = (Ascii, Binary);

     SevenEight =
     RECORD
     CASE mode : EBQtype OF
         Ascii : ( seven  : CHAR   );
        Binary : ( eight  : 0..255 )
     END ;
    { 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 }

     Command = (Transmit,Receive,Invalid,Connect);
     KermitStates = (FileData,Init,Break,FileHeader,EOFile,Complete,Abort);
     EOLtype = (LineFeed,CrLf,JustCr);

     Stats = integer;
     Ppack = ^Packet;

     Intype = (nothing,CRin,abortnow);

    {  Parser defined types }
     vmsString = packed array [1..255] of char;
     string13 = packed array [1..SMALLSIZE] of char;
     string80 = packed array [1..LARGESIZE] of char;
    NewString80 =
       record
          StringPart  : packed array [1..80] of char;
          LengthOfSP  : 0..80
       end;

var
    cmdargs  : 0..MAXCMD;
    LINE,ERRORS,DiskOutFile,DiskInFile : text;
    file3cnt, file4cnt : integer;

    { varibles for  Kermit }
    DiskFile : IOstate ;     { 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: INTEGER;
    MyTimeOut, TheirTimeOut : integer;
    timeOutStatus : boolean;
    Runtype, oldRunType  : command;
    State    : kermitstates;

    STDERR, LineOUT, ControlIN, ControlOUT : filedesc;
    SizeRecv, SizeSend : integer;
    SendEOL, SendQuote : INTEGER;
    myEOL,myQuote: INTEGER;
    EOLFORFILE : EOLtype;
    NumSendPacks, NumRecvPacks : integer;
    NumACK, NumNAK : integer;
    NumACKrecv, NumNAKrecv, NumBADrecv : integer;
    RunTime : integer;
    ChInFileRecv, ChInPackRecv, ChInFileSend, ChInPackSend : Stats;
    Debug : 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 ;
    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  ? }

    IncomingPacket : IOBUFFER;
    BufferPointer, BufferEnd : integer ;

    { Eight Bit Quoting Info }
    sentEBQuote, recvdEBQuote, needEBQuote : boolean; { Used for determining 8 bit state }
    EBQState : EBQtype;    { ... }
    EBQchar : INTEGER;   { Quote character for 8 bit trans }
    ishigh : integer;    { Shift to put high bit on }

    {  Parser defined variables }
    commandLine : string80;
    fileSpec  : string80;
    exitProgram : boolean;
    localEcho, sFileSpec, rFileSpec, lSpeed, transtype : integer;
    escape, debugging, commandLen, fileEol, parity : integer;
    width, linespeed : integer ;
      MAXPACK : 0..MAXPACKETSIZE ;  {number of characters must be less }
                                    {than platen width-otherwise LF is inserted}

   DEFPARITY : integer ;


PROCEDURE Take_Nap (seconds : integer) ; external ;
PROCEDURE set_profile (mode : integer ; {0=get,1=restore}
                      var linespeed : integer ;
                      var width     : integer ; {max line before wrap-around}
                      var parity    : integer ) ; external ;
PROCEDURE set_prompt {NO PROMPT} ; external ;
PROCEDURE set_parity (parity : integer) ; external ;
function ReadCommLine (var IncomingPacket : IOBUFFER ;
                           N : integer ;
                           timeout : integer ;
                       var status : boolean ;
                       var endofline : integer ;
                       var start : integer ) : integer ;
type      line = packed array [1..LineInSize] of char ;
var       Buffer : line ;
          ChValue : SevenEight ;
          k : integer ;
          EOL : char;
PROCEDURE getlineinput (var Buffer : line ;
                            LENGTH : integer ;
                            wait   : integer ; {timeout seconds}
                        var status : boolean ) ; external ;

begin
      EOL := chr (endofline) ;
      for k := 1 to LineInSize do Buffer[k] := EOL ;
      start := 0 ;
      ReadCommLine := 0;
      getlineinput (Buffer, LineInSize, timeout, status) ;
      begin
           k := 1 ;
           while (k <= LineInSize) and (Buffer[k] <> EOL) do
                 begin
                 ReadCommLine := k ;
                 ChValue.seven := Buffer[k] ;
                 IncomingPacket[k] := ChValue.eight ;
                 k := k + 1
                 end ;
      end
end;


function min (a,b: integer) : integer ;
begin if a <= b then
         min := a
      else
         min := b
end ;

function max (a,b: integer) : integer ;
begin if a >= b then
         max := a
      else
         max := b
end ;
procedure GetCf(var c:character);
var
   ch : SevenEight ;
begin
   if not eof(DiskInFile) then
      if eoln(DiskInFile) then
         begin
           readln(DiskInFile);
           c := NEWLINE
         end
      else
         begin
           read(DiskInFile, ch.seven) ;
           c := ch.eight
         end
   else
      c := ENDFILE
end;



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;

function FileOpen (FileName : string80 ; mode : filedesc) : IOstate ;
begin
case mode of
     infile : begin
              Set_File_Parameters (DiskInFile, FileName,
                                  'DCB = DISKINFILE, ERROR=CONTINUE') ;
              reset (DiskInFile) ;
              if File_Status (DiskInFile) = 0 then
                   FileOpen := IOREAD
                 else
                   FileOpen := IOERROR
              end ;

    outfile : begin
              Set_File_Parameters (DiskOutFile, FileName,
                                   'DCB = DISKOUTFILE, CTG = YES') ;
              rewrite (DiskOutFile ) ;
              FileOpen := IOWRITE ;
              end ;
end {case}
end;

procedure Sclose (var fd : IOstate);
begin
case fd of
    IOREAD: Close_file (DiskInFile) ;
   IOWRITE: Close_file (DiskOutFile)
end {case};
   fd := IOAVAIL
end;

procedure Putcf (c : character; fd : filedesc);
var  byte : SevenEight ;
BEGIN
   CASE FD OF
      screen:
              IF (C=NEWLINE) THEN
                 WRITELN(OUTPUT)
              ELSE
                 WRITE(OUTPUT,CHR(C));
      history:
              IF (C=NEWLINE) THEN
                 WRITELN(ERRORS)
              ELSE
                 WRITE(ERRORS,CHR(C));
      RS232:        WRITE(LINE,CHR(C));
      outfile:
                IF (C=NEWLINE) THEN
                   WRITELN(DiskOutFile)
                ELSE
                   begin
                   byte.eight := c ;
                   WRITE(DiskOutFile, byte.seven)
                   end
   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;


procedure Putc (c : character);
{ putc  (UCB) -- put one character on standard output }
begin
   if c = NEWLINE then
      writeln
   else
      write(chr(c));
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;


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;


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 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 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;

         Putcf(NEWLINE,LineOut) ;
end;


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

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

   if (BufferPointer <= BufferEnd) then
      c := IncomingPacket[BufferPointer]
   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;
      end
   else
      begin
         transType := oASCII;
      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 : INTEGER) : 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;
begin
   DebugMessage('DeCodeParm...       ');
   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...         ');

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

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


   State := Init;              { send  initiate is the start state }
   NumTry := 0;                { say no tries  yet }
end;


procedure ResetKermitPacketNumber;
begin
   n := 0;
end;


procedure KermitInit;  { initialize various parameters  & defaults }
VAR platen : integer ;
begin
   set_prompt ;

   set_file_parameters (line,'  ','ORG = TERMINAL') ;
   set_profile (0, {save terminal characteristics}
                     linespeed, {connect baud rate}
                     platen, {total packet most be smaller than this}
                     DEFPARITY) ; {connect parity}
   case linespeed of
0,1,3,8,10,11 : {not support by CP_6} lSpeed := 0 ;
      2,4,5,6 : lSpeed := o300BAUD ;
            7 : lSpeed := o600BAUD ;
            9 : lSpeed := o1200BAUD ;
           12 : lSpeed := o2400BAUD ;
           13 : lSpeed := o4800BAUD ;
        14,15 : lSpeed := o9600BAUD ;
   end {case} ;
   MAXPACK := MAXPACKETSIZE ;
   REWRITE(LINE);
   REWRITE(ERRORS);

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

   localEcho := oOFF;
   parity  := DEFPARITY ;
   fileEol := oCRLF;
   transtype := oASCII;
   Local := true ;      { default to local  }

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

   DiskFile   := IOERROR;      { to indicate  not open yet }
   STDERR     := history ;
   LineOUT    := RS232  ;
   ControlIN  := keyboard ;
   ControlOUT := screen ;

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

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

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


   NumTry := 0;                { say no tries  yet }
   OldRunType := connect ;
   EBQState := Ascii ;
end;


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

  {Sclose(DiskFile);}

   if not(noErrors) then
   else
      begin
         ErrorPack('Aborting Transfer   ');
      end;

   oldRunType := RunType;
   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 necessary  -- then exit }
begin
   DebugMessage('ErrorPack...        ');
   with ThisPacket^ do
      begin
         seq := n;
         ptype := TYPEE;
         CtoS(c,data);
         count := LengthSTIP(data);
      end;
   SendPacket;
end;


procedure PutErr(c:cstring);
{ Print error_messages }
begin
   DebugMessage('PutErr...           ');
   if debug 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(false);
                     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 }
   BufferEnd :=
     ReadCommLine(IncomingPacket,LineInSize,theirtimeout,timeoutstatus,
                 MYEOL,BufferPointer) ;

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

   if (BufferEnd = 0) then
      begin
         ReceivePacket := false;
         if (timeOutStatus) then
            begin
               CurrentPacket^.ptype := TYPET;
               restart := true;
               if (debug) 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
                     GetCf (x) ;
                     if (x<>ENDFILE) then
                        begin
                           if (x < NULL) then
                              case EBQstate of
                               ascii :
                                       ErrorPack('No Binary Support   ');
                               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;
                               if (x<>SendQuote) or (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 GetNextFile: boolean;
{ get next  file to send in ThisPacket }
{there ain't no next file, this baby only sends one file at a time}
{ returns true if no more }

var
    k : integer ;
    result: boolean;
begin
   DebugMessage('GetNextFile...      ');
   result := true;
   if (NumTry=1) then
      begin
        if FileSpec[1] <> ' ' then
           DiskFile := fileopen (filespec,infile) ;
        with ThisPacket^ do
               if DiskFile = IOREAD then
                  begin
                     k := 1;
                     while (FileSpec[k] <> ' ') and (FileSpec[k] <> '.') do
                        begin
                           data[k] := ord (FileSpec[k]) ;
                            FileSpec[k] := ' ';
                           data[k+1] := ENDSTR ;
                           k := k + 1
                        end ;
                     count := LengthSTIP(data);
                     AddTo(ChInFileSend , count);
                     seq := n;
                     ptype := TYPEF;
                     result := false;
                  end ;


      end ;
   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 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 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;
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         ');
   StartRun;
   repeat
      case State of
         FileData: SendData;         { data-send state }
         FileHeader: SENDFILE;         { send file name }
         EOFile: SendEOF;          { send end-of-file }
         Init: begin Take_Nap (Delay); SendInit end ;    { 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 UNDERSCORE = '_' ;

var
    i, j : integer;
    FileName : string80 ;
begin
   DebugMessage ('GetFile...          ');
   with CurrentPacket^ do
      begin
         FileName[1] := '*' ;
         for i := 2 to LARGESIZE do FileName[i] := ' ' ;
         i := 1;
         j := 1;
         repeat
            if (data[i] in [LETA..LETZ, LETsa..LETsz,
               LET0..LET9, PERIOD]) then
               begin
                  FileName[j] := chr (data[i]) ;
                  if data[i] = PERIOD then
                     FileName[j] := UNDERSCORE ;
                  j := j + 1 ; if j > LARGESIZE then j := LARGESIZE ;
               end;
            i := i + 1
         until (data[i] = ENDSTR) ;
      end;
   if rFileSpec = oON then
       begin
       rFileSpec := oOFF ;
       FileName := filespec
       end ;
   diskfile := fileopen (FileName, outfile)
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,outfile);
               CrLf:
                     begin  { don't output   CR }
                        for i:=1 to len do
                           if data[i] <> CR then
                              Putcf(data[i],outfile);
                     end;
               JustCR:
                       begin   { change CR  to NEWLINE }
                          for i:=1 to len do
                             if data[i]=CR then
                                data[i] := NEWLINE;
                          PutStr(data,outfile);
                       end;
            end
         else
            PutStr(data, outfile);
      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 }
         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 debug 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 }
               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>MaxTry 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 }
                     RecvSwitch;
               end;
      Transmit:
                SendSwitch;

      Invalid:        { nothing };
   end; {  case }

   FinishUp(errorOccurred); { end  of program }

end { main   };

{  Include the parser into kermit.(lines 2355-4263) }
{  Determine length of string. }

function LenString(var tempStr : string80) : integer;

var
    i : integer;
    endofstring : boolean;
begin
   i := 80;
   endofstring := false;
   while ((i >= 1) and not(endofstring)) do
      if (tempStr[i] = ' ') then
         i := i - 1
      else
         endofstring := true;

   LenString := i;
end;


{  Copy command line into temporary string until either EOS or blank }

procedure SkipBlanks(var command : string80;
                     var commandLen : integer);

var
    i, k, j, oldComLen : integer;
    endOfString : boolean;

begin

   i := 1;
   endofString := false;
   oldComLen := commandLen;
   while ((i <= commandLen) and (not(endofString))) do
      if (command[i] = ' ') then
         i := i + 1
      else
         endofString := true;

   k := 1;
   for j:=i to commandLen do
      begin
         command[k] := command[j];
         k := k + 1;
      end;

   if ((oldComLen = 1) and (i <> 1)) then
      commandLen := commandLen - i
   else
      commandLen := commandLen - (i-1);
end;


{  Copy command line into temporary string until either EOS or blank }

procedure CopyToken(var command : string80;
                    var commandLen : integer;
                    var tempStr : string13;
                    var totChars : integer);

const
    { %include 'CURRENT_CONSTANT' (lines 2418-2583}
   NULLTOKE = 100;
   RANGENULL = 101;
        KERMITPROMPT = 'Kermit-CP6>';
        KERMITHELP = 'KERMITHLP:';

   INVALIDCOMMAND = 1;
   INVALIDSETCOMMAND = 2;
   INVALIDSHOWCOMMAND = 3;
   NOTIMPLEMENTED = 4;
   INVALIDFILESPEC = 5;
   INVALIDSETCVALUE =  6;
   INVALIDSETDVALUE =  7;
   INVALIDSETOVALUE = 8;
   INVALIDSETRANGE = 9;
        SENDPARMS = 10;
        RECEIVEPARMS = 11;
        LOCALPARMS = 12;
        BLANKLINE = 13;
        NOHELPAVAILABLE = 14;
   IBEXSPAWNFAILED = 15;

   cSET        = 'SET          ';
   cSHOW       = 'SHOW         ';
   cSTATUS     = 'STATUS       ';
   cCONNECT    = 'CONNECT      ';
   cHELP       = 'HELP         ';
   cEXIT       = 'EXIT         ';
   cQUIT       = 'QUIT         ';
   cQUESTION   = '?            ';
   cSEND       = 'SEND         ';
   cRECEIVE    = 'RECEIVE      ';
   cDEBUGGING  = 'DEBUGGING    ';
   cLOCALECHO  = 'LOCAL-ECHO   ';
   cDELAY      = 'DELAY        ';
   cPACKETLENGTH   = 'PACKET-LENGTH';
   cPADDING    = 'PADDING      ';
   cPADCHAR    = 'PADCHAR      ';
   cTIMEOUT    = 'TIMEOUT      ';
   cENDOFLINE  = 'END-OF-LINE  ';
   cQUOTE      = 'QUOTE        ';
   cALL        = 'ALL          ';
   cON     = 'ON           ';
   cOFF        = 'OFF          ';
        cBADTOKEN       = 'XX           ';
   cTRANSMODE  = 'TRANSMODE    ';
   cASCII      = 'ASCII        ';
   cBINARY     = 'BINARY       ';
   cEIGHTQUOTE = 'EIGHT-QUOTE  ';
        cFILERECORD     = 'FILERECORD   ';
        cCR        = 'CR           ';
        cLF        = 'LF           ';
        cCRLF      = 'CRLF         ';
   cPARITY     = 'PARITY       ';
   cEVEN       = 'EVEN         ';
   cODD        = 'ODD          ';
   cNONE       = 'NONE         ';
   cSPEED      = 'SPEED        ';
   cIBEX        = 'IBEX         ';

   uSET = 3;
   uMSEND = 3;
   uMRECEIVE = 1;
   uSHOW = 2;
   uSTATUS = 2;
   uCONNECT = 1;
   uIBEX = 1;
   uHELP = 1;
   uQUESTION = 1;
   uEXIT = 1;
   uQUIT = 1;
   uSEND = 1;
   uRECEIVE = 1;
   uDEBUGGING = 3;
        uFILERECORD = 1;
   uTRANSMODE = 1;
   uLOCALECHO = 2;
   uDELAY = 3;
   uPACKETLENGTH = 3;
   uPADDING = 4;
   uPADCHAR = 4;
   uTIMEOUT = 1;
   uENDOFLINE = 1;
   uQUOTE = 1;
   uALL = 1;
   uON = 2;
   uOFF = 2;
        uBADTOKEN = 1;
        uCR = 2;
        uLF = 1;
        uCRLF = 2;
   uPARITY = 1;
   uEVEN = 1;
   uODD = 1;
   uNONE = 1;
   uSPEED = 2;
   uASCII = 1;
   uBINARY = 1;
   uQUOTED = 1;
   uEIGHTQUOTE = 1;

   oON = 0;
   oOFF = 1;
   oEVEN = 2;
   oODD = 3;
   oNONE = 4;
   oSET = 5;
   oSHOW = 6;
   oSTATUS = 7;
   oCONNECT = 8;
   oHELP = 9;
   oEXIT = 10;
   oQUIT = 11;
   oSEND = 12;
   oRECEIVE = 13;
   oDEBUGGING = 14;
   oLOCALECHO = 15;
   oDELAY = 16;
   oPACKETLENGTH = 17;
   oPADDING = 18;
   oPADCHAR = 19;
   oTIMEOUT = 20;
   oENDOFLINE = 21;
   oQUOTE = 22;
   oQUESTIONM = 23;
   oALL = 24;
        oBADTOKEN = 25;
        oFILERECORD = 26;
        oCR = 27;
        oLF = 28;
        oCRLF = 29;
   oPARITY = 30;
   oSPEED = 31;
   oIBEX = 32;
   oTRANSMODE = 33;
   oASCII = 34;
   oBINARY = 35;
   oEIGHTQUOTE = 36;
   oXXXX = 100 ;

   oMAINTYPE = 1;
   oSETTYPE = 2;
   oSHOWTYPE = 3;
   oSENDTYPE = 4;
   oRECEIVETYPE = 5;
   oDEBUGTYPE = 6;
        oFILERECTYPE = 8;
   oLOCECHOTYPE = 9;
   oPARITYTYPE = 10;
   oTRANSTYPE = 11;

   DECIMAL = 0;
   SDECIMAL = 1;
   OCTAL = 2;
   CHRACTER = 3;
   IDECIMAL = 4;
   EBCHRACTER = 5;

   oASCSTATE = 1;
   oBINSTATE = 0;

   o300BAUD = 300;
   o600BAUD = 600;
   o1200BAUD = 1200;
   o2400BAUD = 2400;
   o4800BAUD = 4800;
   o9600BAUD = 9600;

var
    i, j, k : integer;
    noBlank : boolean;
    tempToken : string80;

begin

   for i:=1 to SMALLSIZE do
      tempStr[i] := ' ';

   i := 1;
   noblank := true;
   while ((i <= commandLen) and (noblank)) do
      if (command[i] <> ' ') then
         begin
            tempToken[i] := command[i];
            i := i + 1;
         end
      else
         noBlank := false;

   totChars := i - 1;

   if (totChars <= SMALLSIZE) then
      for i:=1 to totChars do
         tempStr[i] := tempToken[i]
         else
            begin
               totChars := 2;
               tempStr := cBADTOKEN;
            end;

   k := 1;
   for j:=(totChars+1) to commandLen do
      begin
         command[k] := command[j];
         k := k + 1;
      end;

   commandLen := commandLen - totChars;
end;


{  Routine to compare strings for symbol comparison. }

function CompareStr(command, symbol : string13;
                    commandLen, symbolLen : integer) : boolean;

var
    i : integer;
    sameStr : boolean;

begin
   sameStr := true;
   i := 1;
   while (sameStr and (i <= commandLen)) do
      if command[i] <> symbol[i] then
         sameStr := false
      else
         i := i + 1;
   i := i - 1;

   CompareStr := sameStr and (i >= symbolLen);
end;


procedure StrUpcase(var command : string80;
                    commandLen : integer);

var
    i, diff : integer;

begin
   diff := ord('a') - ord('A');
   for i:=1 to commandLen do
      if ((command[i] >= 'a') and (command[i] <= 'z')) then
         command[i] := chr(ord(command[i]) - diff);
end;


function IsNumeric(token : string13;
                   var tokLen, value : integer;
                   typeToken : integer) : boolean;


var
    goodChar : boolean;
    upBound : char;
    base, i : integer;

begin

   value := 0;
   i := 1;
   goodChar := true;
   upBound := '9';
   base := 10;
   if (typeToken = OCTAL) then
      begin
         upBound := '7';
         base := 8;
      end;

   while ((i <= tokLen) and (goodChar)) do
      if ((token[i] >= '0') and (token[i] <= upBound)) then
         begin
            value := (value*base) + (ord(token[i]) - ord('0'));
            i := i + 1;
         end
      else
         begin
            goodChar := false;
            value := 0;
         end;

   goodChar := goodChar and (tokLen > 0);

   if (typeToken = OCTAL) then
      IsNumeric := goodChar and ((value >= 0) and (value <= 31))
   else
      if (typeToken = SDECIMAL) then
         IsNumeric := goodChar and ((value >= MINPACKETSIZE) and
                      (value <= MAXPACKETSIZE))
   else
      if (typeToken = IDECIMAL) then
         IsNumeric := goodChar and ((value = o300BAUD)
                      or (value=o600BAUD) or (value = o1200BAUD)
                      or (value=o2400BAUD) or (value = o4800BAUD)
                      or (value = o9600BAUD))
   else
      IsNumeric := goodChar and ((value >= 0) and
                   (value <= 99))

end;


{  Print the ? help message for set menu. }

procedure PrintSetHelp;
begin
   writeln;
   writeln;
   writeln('*** HELP ==>');
   writeln;
   writeln('    SET keyword');
   writeln;
   writeln('        Keywords:');
   writeln('          SEND  <option>');
   writeln('          RECEIVE <option>');
   writeln('          TRANSMODE <ASCII | binary>');
   writeln('          EIGHT-QUOTE <character>');
   writeln('          FILERECORD <CRLF | lf | cr>');
   writeln('          PARITY <NONE | even | odd>');
   writeln('          DEBUGGING <on | OFF>');
   writeln('          SPEED  <decimal>');
   writeln('          DELAY  <decimal>');
   writeln;
   writeln('*** END-OF-MESSAGE');
   writeln;
   writeln;
end;


{  Print the ? help message for show menu. }

procedure PrintShowHelp;
begin
   writeln;
   writeln;
   writeln('*** HELP ==>');
   writeln;
   writeln('    SHOW keyword');
   writeln;
   writeln('       Keywords:');
   writeln('         SEND  <option>');
   writeln('         RECEIVE <option>');
   writeln('         TRANSMODE');
   writeln('         EIGHT-QUOTE');
   writeln('         FILERECORD');
   writeln('         DEBUGGING');
   writeln('         SPEED');
   writeln('         DELAY');
   writeln('         ALL');
   writeln;
   writeln('*** END-OF-MESSAGE');
   writeln;
   writeln;
end;


{  Print the ? help message for set send/receive menu. }

procedure PrintSetSendReceiveHelp;
begin
   writeln;
   writeln;
   writeln('*** HELP ==>');
   writeln;
   writeln('    SET SEND/RECEIVE keyword');
   writeln;
   writeln('        Keywords:');
   writeln('          PACKET-LENGTH <decimal>');
   writeln('          PADDING <decimal>');
   writeln('          PADCHAR <octal value>');
   writeln('          TIMEOUT <decimal>');
   writeln('          END-OF-LINE <octal value>');
   writeln('          QUOTE <character>');
   writeln;
   writeln('*** END-OF-MESSAGE');
   writeln;
   writeln;
end;


{  Print the ? help message for show send/receive menu. }

procedure PrintShowSendReceiveHelp;
begin
   writeln;
   writeln;
   writeln('*** HELP ==>');
   writeln;
   writeln('    SHOW SEND/RECEIVE keyword');
   writeln;
   writeln('         Keywords:');
   writeln('           PACKET-LENGTH');
   writeln('           PADDING');
   writeln('           PADCHAR');
   writeln('           TIMEOUT');
   writeln('           END-OF-LINE');
   writeln('           QUOTE');
   writeln;
   writeln('*** END-OF-MESSAGE');
   writeln;
   writeln;
end;


procedure PrintStatus;
{  Print the status of the last send/receive. }

const
      STRWIDTH = 7;

var
    overHead, effectiveRate : integer;
begin
   writeln('  Packets Sent =                ', NumSendPacks : STRWIDTH);
   if (oldRunType = Transmit) then
      begin
         writeln('  Number of ACK packets =       ', NumACKrecv : STRWIDTH);
         writeln('  Number of NAK packets =       ', NumNAKrecv : STRWIDTH);
         writeln('  Number of BAD packets =       ', NumBADrecv : STRWIDTH);
      end
   else
      begin
         writeln('  Number of ACK packets =       ', NumACK : STRWIDTH);
         writeln('  Number of NAK packets =       ', NumNAK : STRWIDTH);
      end;
   writeln('  Data characters Sent =        ', ChInFileSend : STRWIDTH);
   writeln('  Total characters Sent =       ', ChInPackSend : STRWIDTH);
   OverHd(ChInPackSend, ChInFileSend, overHead);
   writeln('  Overhead on Send Packets =    ', overHead : STRWIDTH, ' %');
   writeln(' ');
   writeln('  Packets Received =            ', NumRecvPacks : STRWIDTH);
   writeln('  Data characters Received =    ', ChInFileRecv : STRWIDTH);
   writeln('  Total characters Received =   ', ChInPackRecv : STRWIDTH);
   OverHd(ChInPackRecv, ChInFileRecv, overHead);
   writeln('  Overhead on Receive Packets = ', overHead : STRWIDTH, ' %');

   writeln;

end;


{  Print the message specified. }

procedure PrintMessage(messageNumber : integer);


begin
   case messageNumber of
      NOTIMPLEMENTED :
                       writeln(' ? Not Implemented');
      INVALIDCOMMAND :
                       writeln(' ? Invalid command');
      INVALIDSETCOMMAND :
                          writeln(' ? Invalid set command');
      INVALIDSHOWCOMMAND :
                           writeln(' ? Invalid show command');
      INVALIDFILESPEC :
                        writeln(' ? Invalid file specification');
      INVALIDSETCVALUE :
                         writeln(' ? Bad value: character');
      INVALIDSETDVALUE :
                         writeln(' ? Bad value: decimal');
      INVALIDSETOVALUE :
                         writeln(' ? Bad value: octal');
      INVALIDSETRANGE :
                        writeln(' ? Value not in accepted range');
      NOHELPAVAILABLE :
                        writeln(' ? Not a HELP subject');
      IBEXSPAWNFAILED :
                        writeln(' ? IBEX spawn failed');
      SENDPARMS :
                  writeln('Send Parameters:');
      RECEIVEPARMS :
                     writeln('Receive Parameters:');
      LOCALPARMS :
                   writeln('Local System Parameters:');
      BLANKLINE :
                  writeln(' ');
   end;
end;


procedure ExecShell(dclcommd : string80;
                    commdLen : integer);
{  Call the IBEX shell }

const
      SPAWN = 'SPAWN';
      BLANK = '                                                           ';
      MAXCOMMD = 60;

var
    status, i : integer;
    shellLine : NewString80;

begin

        PrintMessage(NOTIMPLEMENTED);

end;

procedure ScanForToken(var commandLine:String80;
                       var commandLen, token: integer;
                       typeToken:integer);forward;



{  Print out appropriate help message according to the code
   received from either HELPSetShow or PrintHelpCP6.                 }

procedure HelpMessage(code : integer);
begin
   writeln;
   writeln;
   writeln('*** HELP ==>');
   case code of
      1  : begin
              writeln('    SHOW SEND PACKET-LENGTH par');
              writeln;
              writeln('    Description:');
              write('        This command shows the send ');
              writeln('packet length.');
              writeln('    par:');
              write('        may be any decimal value between ');
              writeln('10 and 96');
              writeln('        Default Value = 94');
              writeln;
              writeln('    Note that SETting this will have no effect since');
              writeln('    the remote Kermit will send the value it requires.');
              writeln;
              writeln('    Affect this change by SETting the RECEIVE PACKET-LENGTH');
              writeLN('    parameter of the remote Kermit.');
              writeln;
              writeln('    Example:');
              writeln('        KERMIT-CP6> SHOW SEND PACKET-LENGTH');
              writeln('        KERMIT-IBM> SET RECEIVE PACKET-LENGTH 80');
           end;
      2  : begin
              writeln;
              writeln('    SHOW SEND PADDING ');
              writeln;
              writeln('    Description:');
              write('        This command shows the number of ');
              writeln('padding characters that will be ');
              writeln('        sent to the remote Kermit.  ');
              writeln;
              writeln('    Note that SETting this will have no effect since');
              writeln('    the remote Kermit will send the value it requires.');
              writeln;
              writeln('    Affect this change by SETting the RECEIVE PADDING');
              writeln('    parameter of the remote Kermit.');
              writeln;
              writeln('    Example:');
              writeln('        KERMIT-CP6> SHOW SEND PADDING');
              writeln('        KERMIT-IBM> SET RECEIVE PADDING 30');
           end;
      3  : begin
              writeln;
              writeln('    SHOW SEND PADCHAR ');
              writeln;
              writeln('    Description:');
              write('        This command shows the character ');
              writeln('that will be sent ');
              writeln('        as padding to the remote Kermit.  ');
              writeln;
              writeln('    Note that SETting this parameter will have no effect since');
              writeln('    the remote Kermit will send the value it requires.');
              writeln;
              writeln('    Example:');
              writeln('        KERMIT-CP6> SHOW SEND PADCHAR');
           end;
      4  : begin
              writeln;
              writeln('    SHOW SEND TIMEOUT par');
              writeln;
              writeln('    Description:');
              writeln('        This command shows the number of seconds Kermit CP6');
              writeln('        will wait for a response to a packet sent to the remote Kermit.');
              writeln('        The SEND is terminated if a timeout occurs.');
              writeln('    par:');
              write('        may be any positive decimal number, ');
              writeln('given in seconds');
              writeln('        Default value = 20 seconds');
              writeln;
              writeln('    Note that SETting this will have no effect since');
              writeln('    the remote Kermit will send the value it requires.');
              writeln;
              writeln('    Affect this change by SETting the RECEIVE TIMEOUT');
              writeln('    parameter of the remote Kermit.');
              writeln;
              writeln('    Example:');
              writeln('        KERMIT-CP6> SHOW SEND TIMEOUT');
              writeln('        KERMIT-IBM> SET RECEIVE TIMEOUT 10');
           end;
      5  : begin
              writeln;
              writeln('    SET/SHOW SEND END-OF-LINE par');
              writeln;
              writeln('    Description:');
              write('        This command sets/shows the end of line');
              writeln(' character that KERMITCP6 will ');
              writeln('        send to the remote Kermit.');
              writeln;
              writeln('    par:');
              write('        may be any ASCII value for a character, ');
              writeln('given in octal');
              writeln('        Default value = 15 (ASCII CR, CTRL-M)');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET SEND END-OF-LINE 12');
              writeln('        KERMIT-CP6> SHOW SEND END-OF-LINE');
           end;
      6  : begin
              writeln;
              writeln('    SET/SHOW SEND QUOTE par');
              writeln;
              writeln('    Description:');
              write('        This command sets/shows the printable ');
              writeln('character that KERMITCP6 will ');
              write('        send to the remote Kermit to prefix');
              writeln(' control characters.');
              writeln('    par:');
              writeln('        may be any printable character');
              writeln('        Default value = "#" (ASCII 35(dec) )');
              writeln('        NOTE:  Change the quote character to send ');
              writeln('               CP6 files with many ''#'' characters.');
              writeln('    Affect this change by');
              write('      SETting the RECEIVE QUOTE parameter');
              writeln(' of the remote KERMIT,');
              write('              the SEND QUOTE parameter');
              writeln(' of the remote KERMIT, and');
              write('              the SEND QUOTE parameter');
              writeln(' of CP6 KERMIT to the same value.');
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SHOW SEND  QUOTE');
              writeln('        KERMIT-CP6> SET SEND QUOTE +');
              writeln('        KERMIT-IBM> SET SEND QUOTE 43 (The ASCII value of ''+'' is 43.) ');
              writeln('        KERMIT-IBM> SET RECEIVE QUOTE 43');
           end;
      7  : begin
              writeln(code)
           end;
      8  : begin
              writeln;
              writeln('    SET/SHOW RECEIVE PACKET-LENGTH par');
              writeln;
              writeln('    Description:');
              writeln('        This command sets/shows the maximum of characters');
              writeln('        in a message received by KermitCP6.');
              writeln;
              writeln('    par:');
              write('        may be any decimal value between ');
              writeln('10 and 96');
              writeln('        Default Value = 94');
              writeln;
              writeln('    Examples: ');
              writeln('        KERMIT-CP6> SET RECEIVE PACKET-LENGTH 60');
              writeln('        KERMIT-CP6> SHOW RECEIVE PACKET-LENGTH');
           end;
      9  : begin
              writeln;
              writeln('    SET/SHOW RECEIVE PADDING par');
              writeln;
              writeln('    Description:');
              write('        This command sets/shows the number of ');
              writeln('padding characters that will ');
              writeln('        precede a message received by KERMITCP6.');
              writeln;
              writeln('    par:');
              writeln('        may be any positive decimal number');
              writeln('        Default value = 0');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET RECEIVE PADDING 5');
              writeln('        KERMIT-CP6> SHOW RECEIVE PADDING');
           end;
      10 : begin
              writeln;
              writeln('    SET/SHOW RECEIVE PADCHAR par');
              writeln;
              writeln('    Description:');
              write('        This command sets/shows the character ');
              writeln('that will precede ');
              writeln('        a message received by KERMITCP6.');
              writeln('        See SET RECEIVE PADDING.');
              writeln;
              writeln('    par:');
              writeln('        may be any ASCII value, given as an octal ');
              writeln('        number in the range: 0-37, or 177');
              writeln('        Default value = 0  (ASCII NUL)');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET RECEIVE PADCHAR 15');
              writeln('        KERMIT-CP6> SHOW RECEIVE PADCHAR');
           end;
      11 : begin
              writeln;
              writeln('    SET/SHOW RECEIVE TIMEOUT par');
              writeln;
              writeln('    Description:');
              write('        This command sets/shows the number of ');
              writeln('seconds KERMITCP6 will ');
              writeln('        wait while attempting to receive a message from the remote Kermit.');
              writeln;
              writeln('    par:');
              write('        may be any positive decimal number, ');
              writeln('given in seconds');
              writeln('        Default value = 20 seconds');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET RECEIVE TIMEOUT 15');
              writeln('        KERMIT-CP6> SHOW RECEIVE TIMEOUT');
           end;
      12 : begin
              writeln;
              writeln('    SET/SHOW RECEIVE END-OF-LINE par');
              writeln;
              writeln('    Description:');
              write('        This command sets/shows the end of line');
              writeln(' character that KERMITCP6 will ');
              writeln('        expect to receive from the remote Kermit.');
              writeln;
              writeln('    par:');
              write('        may be any ASCII value for a character, ');
              writeln('given in octal');
              writeln('        Default value = 15 (ASCII CR, CTRL-M)');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET RECEIVE END-OF-LINE 12');
              writeln('        KERMIT-CP6> SHOW RECEIVE END-OF-LINE');
           end;
      13 : begin
              writeln;
              writeln('    SET/SHOW RECEIVE QUOTE par');
              writeln;
              writeln('    Description:');
              writeln('        This command sets/shows the printable character KermitCP6 expects');
              writeln('        to be prefixed to the control characters of messages sent');
              writeln('        by the remote Kermit.');
              writeln('    par:');
              writeln('        may be any printable character');
              writeln('        Default value = "#" (ASCII 35(dec) )');
              writeln('     NOTE:  Change the quote character to receive remote Kermit');
              writeln('            files with many ''#'' characters.');
              writeln('    Affect this change by SETting');
              writeln('        the SEND QUOTE parameter of the remote Kermit,');
              writeln('        the SEND QUOTE parameter of CP6 Kermit, and');
              writeln('        the RECEIVE QUOTE parameter of CP6 Kermit to the same value.');
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SHOW SEND  QUOTE');
              writeln('        KERMIT-CP6> SET RECEIVE QUOTE +');
              writeln('        KERMIT-CP6> SET SEND QUOTE +');
              writeln('        KERMIT-IBM> SET SEND QUOTE 43  (The ASCII value of ''+'' is 43.)');
           end;
      14 : begin
              writeln(code)
           end;
      15 : begin
              writeln;
              writeln('    SET/SHOW TRANSMODE par');
              writeln;
              writeln('    Description:');
              write('        This command sets/shows the type of ');
              writeln('file that KERMITCP6 ');
              writeln('        will receive.');
              writeln;
              writeln('    par:');
              writeln('        must be one of the following...');
              writeln('             ASCII  - for text files');
              writeln('             BINARY - for non-text files');
              writeln('        Default value = ASCII');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET TRANSMODE BINARY');
              writeln('        KERMIT-CP6> SHOW TRANSMODE');
           end;
      16 : begin
              writeln;
              writeln('    SET/SHOW EIGHT-QUOTE par');
              writeln;
              writeln('    Description:');
              write('        This command sets/shows the character ');
              writeln('that KERMITCP6 will send ');
              write('        to the remote Kermit as a quote for');
              writeln(' eight-bit characters.');
              writeln;
              writeln('    par:');
              writeln('        may be any printable character');
              writeln('        Default value = "&"  (ASCII 38(dec) )');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET EIGHT-QUOTE %');
              writeln('        KERMIT-CP6> SHOW EIGHT-QUOTE');
           end;
      17 : begin
              writeln;
              writeln('    SET/SHOW DEBUGGING par');
              writeln;
              writeln('    Description:');
              writeln('        This command sets/shows the state of KermitCP6''s debugging');
              writeln('        messages.  When on, messages are sent to the user''s terminal.');
              writeln('        Redirect messages to a CP6 file by using an');
              writeln('        IBEX SET command ''!SET DEBUGGING fid, CTG=YES''.');
              writeln;
              writeln('    par:');
              writeln('        must be ON or OFF');
              writeln('        Default value = OFF');
              writeln('    NOTE:  Debugging is only meaningful for modification of Kermit code.');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET DEBUGGING ON');
              writeln('        KERMIT-CP6> SHOW DEBUGGING');
           end;
      18 : begin
              writeln;
              writeln('    SET/SHOW FILERECORD par');
              writeln;
              writeln('    Description:');
              writeln('        This command sets/shows the end of line character being used ');
              writeln('        to separate records in a file being  sent from CP6 ');
              writeln('        to the remote Kermit.');
              writeln;
              writeln('    par:');
              writeln('        must be one of the following ...');
              writeln('           CR   - a carriage return');
              writeln('           LF   - a line feed');
              write('           CRLF  - a carriage return, ');
              writeln('followed by a linefeed');
              writeln('        Default value = CRLF');
              writeln;
              writeln('    SUGGESTED USE:');
              writeln('        SET FILERECORD LF to transmit a PASCAL source to an APPLE IIe.');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET FILERECORD LF');
              writeln('        KERMIT-CP6> SHOW FILERECORD');
           end;
      19 : begin
           end;
      20 : begin
              writeln;
              writeln('    SET/SHOW PARITY par');
              writeln;
              writeln('    Description:');
              write('        This command sets/shows the type of ');
              writeln('parity being used on the ');
              writeln('        the transmission line.');
              writeln;
              writeln('    par:');
              writeln('        must be EVEN, ODD, or NONE');
              write('        Default value = NONE (others require ');
              writeln('eight-bit prefixing ');
              writeln('                             for binary files)');
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET PARITY EVEN');
              writeln('        KERMIT-CP6> SHOW PARITY');
           end;
      21 : begin
              writeln;
              writeln('    SHOW SPEED ');
              writeln;
              writeln('    Description:');
              write('        This command shows the baud rate ');
              writeln('of transmission.');
              writeln;
              writeln('    NOTE:  SPEED must be SET by the microcomputer Kermit.');
              writeln;
              writeln('    Example:');
              writeln('        KERMIT-CP6> SHOW SPEED');
           end;
      22 : begin
              writeln;
              writeln('    SET/SHOW DELAY par');
              writeln;
              writeln('    Description:');
              write('        This command sets/shows the number ');
              writeln('of seconds KERMITCP6 will ');
              write('        wait before sending data following ');
              writeln('a SEND command.');
              writeln;
              writeln('    par:');
              write('        may be any positive decimal number, ');
              writeln('given in seconds');
              writeln('        Default value = 5 seconds');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SET DELAY 25');
              writeln('        KERMIT-CP6> SHOW DELAY');
              writeln('        NOT YET IMPLEMENTED !!');
           end;
      23 : begin
              writeln(code)
           end;
      24 : begin
              writeln;
              writeln('    SHOW ALL');
              writeln;
              writeln('    Description:');
              writeln('        This command shows the current values of the KermitCP6');
              writeln('        SEND, RECEIVE, and Local System parameters.');
              writeln;
              writeln('    Example:');
              writeln('        KERMIT-CP6> SHOW ALL');
           end;
      25 : begin
              writeln;
              writeln('    SEND filespec');
              writeln;
              writeln('    Description:');
              write('        This command will send the specified ');
              writeln('CP6 file to the remote ');
              writeln('        Kermit.');
              writeln;
              writeln('    filespec:');
              writeln('        any valid, existing CP6 file-specification.');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> SEND MYFILE');
              writeln('        KERMIT-CP6> SEND ANOTHER_FILE');
           end;
      26 : begin
              writeln;
              writeln('    RECEIVE filespec');
              writeln;
              writeln('    Description:');
              write('        This command will prepare KERMITCP6 ');
              writeln('to receive a file being ');
              writeln('        sent by the remote Kermit.');
              writeln;
              writeln('    filespec:');
              writeln('        any valid CP6 file-specification. ');
              write('        if omitted, the file-specification ');
              writeln('will be obtained from the ');
              write('           file header sent by the remote ');
              writeln('Kermit.');
              writeln;
              writeln('    WARNING!  KERMIT will overwrite an existing');
              writeln('              file with the given filespec.');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> RECEIVE MYFILE');
              writeln('        KERMIT-CP6> RECEIVE');
           end;
      27 : begin
              writeln;
              writeln('    STATUS');
              writeln;
              writeln('    Description:');
              writeLN('      This command will display information ');
              writeln('      on the most recent transmission of data.');
              writeln;
              writeln('    Example:');
              writeln('        KERMIT-CP6> STATUS');
           end;
      28 : begin
           end;
      29 : begin
              writeln;
              writeln('    The following are valid KERMIT-CP6 commands:');
              writeln;
              write('      STATUS      HELP        EXIT        QUIT');
              writeln('      RECEIVE     SEND ');
              writeln('      SET         SHOW        ');
              writeln;
              write('    In order to use the HELP facilities on ');
              writeln('KERMIT-CP6, type ''HELP command''.  ');
              write('    Abbreviated HELP can be obtained on selected');
              writeln(' commands by typing ''command ?''.');
           end;
      30 : begin
              writeln;
              writeln('    EXIT/QUIT');
              writeln;
              writeln('    Description:');
              write('        This command allows the user to ');
              writeln('exit KERMITCP6 and return to IBEX.');
              writeln;
              writeln('    Examples:');
              writeln('        KERMIT-CP6> QUIT');
              writeln('        KERMIT-CP6> EXIT');
           end;
      31 : begin
              writeln(code)
           end;
      32 : begin
              writeln(code)
           end
   end; {of case code of}
   writeln;
   writeln('*** END-OF-MESSAGE');
   writeln
end;

{  Parse the help set/show command and print the appropriate
   help message.                                                     }

procedure HELPSetShow(var commandLine : string80;
                      var commandLen : integer;
                      commandType : integer);


var
    token : integer;

begin
   ScanForToken(commandLine, commandLen, token, commandType);

   if (token in [oSEND, oRECEIVE, oDEBUGGING, oDELAY,
      oQUESTIONM, oALL, oFILERECORD, oPARITY, oSPEED,
      oTRANSMODE, oEIGHTQUOTE]) or (token =  NULLTOKE) then
      case token of
         oSEND    :
                    begin
                       ScanForToken(commandLine, commandLen, token, oSENDTYPE);
             { This next line checks if token is oPACKETLENGTH, oPADDING,
               oPADCHAR, oTIMEOUT, oENDOFLINE, oQUOTE, or oQUESTIONM. }
                       if ((token>=oPACKETLENGTH) and (token<=oQUESTIONM)) or
                          (token = NULLTOKE) then
                          case token of
                             oPACKETLENGTH : HelpMessage(1);
                             oPADDING : HelpMessage(2);
                             oPADCHAR : HelpMessage(3);
                             oTIMEOUT : HelpMessage(4);
                             oENDOFLINE : HelpMessage(5);
                             oQUOTE : HelpMessage(6);
                             oQUESTIONM,
                             NULLTOKE : if commandType = oSETTYPE then
                                         PrintSetSendReceiveHelp
                                        else
                                         PrintShowSendReceiveHelp;
                          end { inner case token of }
                       else
                          begin
                             PrintMessage(NOHELPAVAILABLE);
                             HelpMessage(29)
                          end
                    end; {of oSEND case}

         oRECEIVE :
                    begin
                       ScanForToken(commandLine, commandLen, token, oRECEIVETYPE);
             { This next line checks if token is oPACKETLENGTH, oPADDING,
               oPADCHAR, oTIMEOUT, oENDOFLINE, oQUOTE, or oQUESTIONM. }
                       if ((token>=oPACKETLENGTH) and (token<=oQUESTIONM)) or
                          (token = NULLTOKE) then
                          case token of
                             oPACKETLENGTH : HelpMessage(8);
                             oPADDING : HelpMessage(9);
                             oPADCHAR : HelpMessage(10);
                             oTIMEOUT : HelpMessage(11);
                             oENDOFLINE : HelpMessage(12);
                             oQUOTE : HelpMessage(13);
                             oQUESTIONM,
                             NULLTOKE : if commandType = oSETTYPE then
                                         PrintSetSendReceiveHelp
                                        else
                                         PrintShowSendReceiveHelp;
                          end {inner case token of}
                       else
                          begin
                             PrintMessage(NOHELPAVAILABLE);
                             HelpMessage(29);
                          end
                    end; {of oRECEIVE case}

         oTRANSMODE : HelpMessage(15);
         oEIGHTQUOTE : HelpMessage(16);
         oDEBUGGING : HelpMessage(17);
         oFILERECORD : HelpMessage(18);
         oPARITY : HelpMessage(20);
         oSPEED : HelpMessage(21);
         oDELAY : HelpMessage(22);
         oALL : if commandType = oSHOWTYPE then
                   HelpMessage(24)
                else
                   begin
                      PrintMessage(NOHELPAVAILABLE);
                      PrintSetHelp
                   end;
         oQUESTIONM,
         NULLTOKE : if commandType = oSETTYPE then
                       PrintSetHelp
                    else
                       PrintShowHelp;
      end { of outer case token of }
   else
      begin
         PrintMessage(NOHELPAVAILABLE);
         HelpMessage(29)
      end
end;







{  Routine to print appropriate help message.
   Determines token following help. }

procedure PrintHelpCP6(var commandLine : String80;
                       var commandLen : integer);


var
    token : integer;


begin
   ScanForToken(commandLine, commandLen, token, oMAINTYPE);
    { Make HELP and HELP HELP equivalent statements. }
   if token = NULLTOKE then
      token := oHELP;
   if token in [oSET, oSHOW, oSTATUS,  oHELP, oEXIT,
      oQUIT, oSEND, oRECEIVE, oQUESTIONM] then
      case token of
         oSET       : HELPSetShow(commandLine, commandLen, oSETTYPE);
         oSHOW      : HELPSetShow(commandLine, commandLen, oSHOWTYPE);
         oSEND      : HelpMessage(25);
         oRECEIVE   : HelpMessage(26);
         oSTATUS    : HelpMessage(27);
         oHELP,
         oQUESTIONM : HelpMessage(29);
         oEXIT,
         oQUIT      : HelpMessage(30);
      end { of case token of }
   else
      begin
         PrintMessage(NOHELPAVAILABLE);
         HelpMessage(29);
      end
end;




{  Routine to print parameter values. }

procedure PrintParmValue(value, token : integer);


begin
   case token of
      oPACKETLENGTH :
                      writeln('  Packet-Length =         ', value : 2, ' (dec)');
      oPADDING :
                 writeln('  Padding =               ', value : 2, ' (dec)');
      oPADCHAR :
                 writeln('  Padding Character =     ', value, ' (decimal)');
      oTIMEOUT :
                 writeln('  Time-out length =       ', value : 2, ' (sec)');
      oENDOFLINE :
                   writeln('  End of Line Character = ', value, ' (decimal)');
      oQUOTE :
               writeln('  Quote Character =       ', chr(value));
      oTRANSMODE :
                   begin
                      write('  File Transfer Type =    ');
                      if (value = oASCII) then
                         writeln('ascii')
                      else
                         writeln('binary');
                   end;
      oEIGHTQUOTE :
                    writeln('  Eight-Bit Quote =       ', chr(value));
      oFILERECORD :
                    begin
                       write('  End of Line for file =  ');
                       if (value = oCR) then
                          writeln('cr')
                       else
                          if (value = oLF) then
                             writeln('lf')
                       else
                          writeln('cr/lf');
                    end;
      oDELAY :
               writeln('  Delay =                 ', value : 2, ' (sec)');
      oDEBUGGING :
                   begin
                      write('  Debugging =             ');
                      if (value = oOFF) then
                         writeln('off')
                      else
                         writeln('on');
                   end;
      oPARITY :
                begin
                   write('  Parity =                ');
                   if (value = oEVEN) then
                      writeln('even')
                   else
                      if (value = oODD) then
                         writeln('odd')
                   else
                      writeln('none');
                end;
      oSPEED :
               writeln('  Line Speed =            ', lSpeed : 4);
   end;
end;


{  Routine to scan for an appropriate value }

procedure ScanForValue(var command : string80;
                       var commandLen, value : integer;
                       convertType, commandType : integer);


var
    tempToken : string13;
    totChars  : integer;
    badvalue : boolean;

begin

   CopyToken(command, commandLen, tempToken, totChars);

   case convertType of
      DECIMAL ,
      SDECIMAL,
      IDECIMAL :
                 if not(IsNumeric(tempToken, totChars, value, convertType)) and
                    (commandType <> oSHOWTYPE) then
                    begin
                       PrintMessage(INVALIDSETDVALUE);
                       value := RANGENULL;
                    end;
      OCTAL :
              if not(IsNumeric(tempToken, totChars, value, convertType)) and
                 (commandType <> oSHOWTYPE) then
                 begin
                    PrintMessage(INVALIDSETOVALUE);
                    value := RANGENULL;
                 end;
      CHRACTER :
                 if (totChars = 1) then
                    value := ord(tempToken[1])
                 else
                    if (commandType <> oSHOWTYPE) then
                       begin
                          PrintMessage(INVALIDSETCVALUE);
                          value := RANGENULL;
                       end;
      EBCHRACTER :
                   begin
                      if (totChars = 1) then
                         begin
                            value := ord(tempToken[1]);
                            badvalue := false;
                            if (not(value in [EXMARK..RABRACK, GRAVE..TILDE])) then
                               badvalue := true;
                         end
                      else
                         badvalue := true;
                      if ((commandType <> oSHOWTYPE) and (badvalue)) then
                         begin
                            PrintMessage(INVALIDSETCVALUE);
                            value := RANGENULL;
                         end;
                   end;
   end;
end;


{  Determine if we have a valid number, and if so set it.  }

procedure TestAndSetValue(var value, numberToSet : integer;
                          token, commandType : integer);


begin
   if (commandType = oSHOWTYPE) then
      PrintParmValue(numberToSet, token)
   else
      if (value = NULLTOKE) then
         begin
            PrintMessage(INVALIDSETCOMMAND);
         end
   else
      if (value <> RANGENULL) then
         numberToSet := value;
end;


{  Routine to print the value of all parameters in program.  }

procedure PrintAllParameters;


begin
   PrintMessage(SENDPARMS);
   PrintParmValue(SizeSend, oPACKETLENGTH);
   PrintParmValue(Pad, oPADDING);
   PrintParmValue(PadChar, oPADCHAR);
   PrintParmValue(TheirTimeOut, oTIMEOUT);
   PrintParmValue(SendEOL, oENDOFLINE);
   PrintParmValue(SendQuote, oQUOTE);

   PrintMessage(RECEIVEPARMS);
   PrintParmValue(SizeRecv, oPACKETLENGTH);
   PrintParmValue(MyPad, oPADDING);
   PrintParmValue(MyPadChar, oPADCHAR);
   PrintParmValue(MyTimeOut, oTIMEOUT);
   PrintParmValue(MyEOL, oENDOFLINE);
   PrintParmValue(MyQuote, oQUOTE);

   PrintMessage(LOCALPARMS);
   PrintParmValue(transtype, oTRANSMODE);
   PrintParmValue(EBQChar, oEIGHTQUOTE);
   PrintParmValue(fileEol, oFILERECORD);
   PrintParmValue(parity, oPARITY);
   PrintParmValue(lSpeed, oSPEED);
   PrintParmValue(Delay, oDELAY);
   PrintParmValue(debugging, oDEBUGGING);
end;


{  Routine to parse send/receive command for file name or wildcard des. }

procedure ParseSendReceiveCommand(var commandLine : string80;
                                  var commandLen : integer;
                                  var tempFile : string80;
                                  var token : integer);


var
    i : integer;

begin
   for i:=1 to LARGESIZE do
      tempFile[i] := ' ';

   if ((commandLine[1] <> ' ') and (commandLen > 0)) then
      begin

         if (commandLen > LARGESIZE) then
            commandLen := LARGESIZE;

         for i := 1 to commandLen do
            tempFile[i] := commandLine[i];

         if (commandLine[1] = '?') then
            begin
               if token = oSEND then
                  HelpMessage(25)
               else
                  HelpMessage(26);
               token := oXXXX;
            end
         else
            if token = oSEND then
               sFileSpec := oON
         else
            rFileSpec := oON;
      end {end if}
   else
      begin
         if token = oSEND then
            begin
               sFileSpec := oOFF;
               PrintMessage(INVALIDFILESPEC)
            end
         else
            rFileSpec := oOFF
      end; {end if}


end;


{  Get a valid token form the command line and return it. }
procedure ScanForToken;


var
    tempToken : string13;
    totChars : integer;

begin

   CopyToken(commandLine, commandLen, tempToken, totChars);
   SkipBlanks(commandLine, commandLen);

   token := oBADTOKEN;
   if (totChars <> 0) then
      case typeToken of
         oMAINTYPE :
                     if (CompareStr(tempToken, cSET, totChars, uSET)) then
                        token := oSET
                     else
                        if (CompareStr(tempToken, cSHOW, totChars, uSHOW)) then
                           token := oSHOW
                     else
                        if (CompareStr(tempToken, cSTATUS, totChars, uSTATUS)) then
                           token := oSTATUS
                     else
                        if (CompareStr(tempToken, cSEND, totChars, uMSEND)) then
                           token := oSEND
                     else
                        if (CompareStr(tempToken, cRECEIVE, totChars, uMRECEIVE)) then
                           token := oRECEIVE
                     else
                        if (CompareStr(tempToken, cIBEX, totChars, uIBEX)) then
                           token := oIBEX
                     else
                        if (CompareStr(tempToken, cHELP, totChars, uHELP)) then
                           token := oHELP
                     else
                        if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
                           token := oQUESTIONM
                     else
                        if (CompareStr(tempToken, cQUIT, totChars, uQUIT)) then
                           token := oQUIT
                     else
                        if (CompareStr(tempToken, cEXIT, totChars, uEXIT)) then
                           token := oEXIT;

         oSETTYPE,
         oSHOWTYPE :
                     if (CompareStr(tempToken, cSEND, totChars, uSEND)) then
                        token := oSEND
                     else
                        if (CompareStr(tempToken, cRECEIVE, totChars, uRECEIVE)) then
                           token := oRECEIVE
                     else
                        if (CompareStr(tempToken, cTRANSMODE, totChars, uTRANSMODE)) then
                           token := oTRANSMODE
                     else
                        if (CompareStr(tempToken, cEIGHTQUOTE, totChars, uEIGHTQUOTE)) then
                           token := oEIGHTQUOTE
                     else
                        if (CompareStr(tempToken, cDEBUGGING, totChars, uDEBUGGING)) then
                           token := oDEBUGGING
                     else
                        if (CompareStr(tempToken, cFILERECORD, totChars, uFILERECORD)) then
                           token := oFILERECORD
                     else
                        if (CompareStr(tempToken, cDELAY, totChars, uDELAY)) then
                           token := oDELAY
                     else
                        if (CompareStr(tempToken, cPARITY, totChars, uPARITY)) then
                           token := oPARITY
                     else
                        if (CompareStr(temptoken, cSPEED, totChars, uSPEED)) then
                           token := oSPEED
                     else
                        if (CompareStr(tempToken, cALL, totChars, uALL)) then
                           token := oALL
                     else
                        if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
                           token := oQUESTIONM;

         oSENDTYPE,
         oRECEIVETYPE :
                        if (CompareStr(tempToken, cPACKETLENGTH, totChars, uPACKETLENGTH)) then
                           token := oPACKETLENGTH
                        else
                           if (CompareStr(tempToken, cPADDING, totChars, uPADDING)) then
                              token := oPADDING
                        else
                           if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
                              token := oQUESTIONM
                        else
                           if (CompareStr(tempToken, cPADCHAR, totChars, uPADCHAR)) then
                              token := oPADCHAR
                        else
                           if (CompareStr(tempToken, cTIMEOUT, totChars, uTIMEOUT)) then
                              token := oTIMEOUT
                        else
                           if (CompareStr(tempToken, cENDOFLINE, totChars, uENDOFLINE)) then
                              token := oENDOFLINE
                        else
                           if (CompareStr(tempToken, cQUOTE, totChars, uQUOTE)) then
                              token := oQUOTE;

         oTRANSTYPE :
                      if (CompareStr(tempToken, cASCII, totChars, uASCII)) then
                         token := oASCII
                      else
                         if (CompareStr(tempToken, cBINARY, totChars, uBINARY)) then
                            token := oBINARY;

         oDEBUGTYPE,
         oLOCECHOTYPE :
                        if (CompareStr(tempToken, cON, totChars, uON)) then
                           token := oON
                        else
                           if (CompareStr(tempToken, cOFF, totChars, uOFF)) then
                              token := oOFF;

         oFILERECTYPE :
                        if (CompareStr(tempToken, cCR, totChars, uCR)) then
                           token := oCR
                        else
                           if (CompareStr(tempToken, cLF, totChars, uLF)) then
                              token := oLF
                        else
                           if (CompareStr(tempToken, cCRLF, totChars, uCRLF)) then
                              token := oCRLF;

         oPARITYTYPE :
                       if (CompareStr(tempToken, cEVEN, totChars, uEVEN)) then
                          token := oEVEN
                       else
                          if (CompareStr(tempToken, cODD, totChars, uODD)) then
                             token := oODD
                       else
                          if (CompareStr(tempToken, cNONE, totChars, uNONE)) then
                             token := oNONE;
      end  {of case typeToken of}
   else
      token := NULLTOKE

end;


{  Parse the set and show command and the proceed to set appropriate
   kermit variables.                                                 }

procedure ParseSetShowCommand(var commandLine : string80;
                              var commandLen : integer;
                              commandType : integer);


var
    token, value : integer;

begin
   ScanForToken(commandLine, commandLen, token, commandType);

   if token in [oSEND, oRECEIVE, oDEBUGGING,  oDELAY,
      oQUESTIONM, oALL, oFILERECORD, oPARITY, oSPEED,
      oTRANSMODE, oEIGHTQUOTE] then
      case token of
         oSEND    :
                    begin
                       ScanForToken(commandLine, commandLen, token, oSENDTYPE);
             { This next line checks if token is oPACKETLENGTH, oPADDING,
               oPADCHAR, oTIMEOUT, oENDOFLINE, oQUOTE, or oQUESTIONM. }
                       if ((token>=oPACKETLENGTH) and (token<=oQUESTIONM)) then
                          case token of
                             oPACKETLENGTH :
                                             begin
                                              ScanForValue(commandLine, commandLen, value,
                                                           SDECIMAL, commandType);
                                              TestAndSetValue(value, SizeSend, token,
                                                              commandType);
                                             end;
                             oPADDING :
                                        begin
                                         ScanForValue(commandLine, commandLen, value,
                                                      DECIMAL, commandType);
                                         TestAndSetValue(value, Pad, token, commandType);
                                        end;
                             oPADCHAR :
                                        begin
                                         ScanForValue(commandLine, commandLen, value,
                                                      OCTAL, commandType);
                                         TestAndSetValue(value, PadChar, token,
                                                         commandType);
                                        end;
                             oTIMEOUT :
                                        begin
                                         ScanForValue(commandLine, commandLen, value,
                                                      DECIMAL, commandType);
                                         TestAndSetValue(value, TheirTimeOut, token,
                                                         commandType);
                                        end;
                             oENDOFLINE :
                                          begin
                                           ScanForValue(commandLine, commandLen, value,
                                                        OCTAL, commandType);
                                           TestAndSetValue(value, SendEol, token,
                                                           commandType);
                                          end;
                             oQUOTE :
                                      begin
                                       ScanForValue(commandLine, commandLen, value,
                                                    CHRACTER, commandType);
                                       TestAndSetValue(value, SendQuote, token,
                                                       commandType);
                                      end;
                             oQUESTIONM :
                                          if (commandType = oSETTYPE) then
                                           PrintSetSendReceiveHelp
                                          else
                                           PrintShowSendReceiveHelp;
                          end { inner case token of }
                       else
                          if (commandType = oSETTYPE) then
                             PrintMessage(INVALIDSETCOMMAND)
                       else
                          PrintMessage(INVALIDSHOWCOMMAND);
                    end; {of oSEND case}

         oRECEIVE :
                    begin
                       ScanForToken(commandLine, commandLen, token, oRECEIVETYPE);
             { This next line checks if token is oPACKETLENGTH, oPADDING,
               oPADCHAR, oTIMEOUT, oENDOFLINE, oQUOTE, or oQUESTIONM. }
                       if ((token>=oPACKETLENGTH) and (token<=oQUESTIONM)) then
                          case token of
                             oPACKETLENGTH :
                                             begin
                                              ScanForValue(commandLine, commandLen, value,
                                                           SDECIMAL, commandType);
                                              TestAndSetValue(value, SizeRecv, token,
                                                              commandType);
                                             end;
                             oPADDING :
                                        begin
                                         ScanForValue(commandLine, commandLen, value,
                                                      DECIMAL, commandType);
                                         TestAndSetValue(value, MyPad, token, commandType);
                                        end;
                             oPADCHAR :
                                        begin
                                         ScanForValue(commandLine, commandLen, value,
                                                      OCTAL, commandType);
                                         TestAndSetValue(value, MyPadChar, token,
                                                         commandType);
                                        end;
                             oTIMEOUT :
                                        begin
                                         ScanForValue(commandLine, commandLen, value,
                                                      DECIMAL, commandType);
                                         TestAndSetValue(value, MyTimeOut, token,
                                                         commandType);
                                        end;
                             oENDOFLINE :
                                          begin
                                           ScanForValue(commandLine, commandLen, value,
                                                        OCTAL, commandType);
                                           TestAndSetValue(value, MyEol, token,
                                                           commandType);
                                          end;
                             oQUOTE :
                                      begin
                                       ScanForValue(commandLine, commandLen, value,
                                                    CHRACTER, commandType);
                                       TestAndSetValue(value, MyQuote, token,
                                                       commandType);
                                      end;
                             oQUESTIONM :
                                          if (commandType = oSETTYPE) then
                                           PrintSetSendReceiveHelp
                                          else
                                           PrintShowSendReceiveHelp;
                          end { of inner case token of }
                       else
                          if (commandType = oSETTYPE) then
                             PrintMessage(INVALIDSETCOMMAND)
                       else
                          PrintMessage(INVALIDSHOWCOMMAND);
                    end; {of oRECEIVE case}

         oTRANSMODE :
                      begin
                         ScanForToken(commandLine, commandLen, value, oTRANSTYPE);
                         TestAndSetValue(value, transtype, token, commandType);
                      end;
         oEIGHTQUOTE :
                       begin
                          ScanForValue(commandLine, commandLen, value,
                                       EBCHRACTER, commandType);
                          TestAndSetValue(value, EBQChar, token, commandType);
                       end;
         oDEBUGGING :
                      begin
                         ScanForToken(commandLine, commandLen, value, oDEBUGTYPE);
                         TestAndSetValue(value, debugging, token, commandType);
                      end;
         oFILERECORD :
                       begin
                          ScanForToken(commandLine, commandLen, value, oFILERECTYPE);
                          TestAndSetValue(value, fileEOL, token, commandType);
                       end;
         oPARITY :
                   begin
                      ScanForToken(commandLine, commandLen, value, oPARITYTYPE);
                      TestAndSetValue(value, parity, token, commandType);
                   end;
         oSPEED :
                  begin
                     ScanForValue(commandLine, commandLen, value,
                                  IDECIMAL, commandType);
                     TestAndSetValue(value, lSpeed, token, commandType);
                  end;
         oDELAY :
                  begin
                     ScanForValue(commandLine, commandLen, value,
                                  DECIMAL, commandType);
                     TestAndSetValue(value, delay, token, commandType);
                  end;
         oQUESTIONM :
                      if (commandType = oSETTYPE) then
                         PrintSetHelp
                      else
                         PrintShowHelp;
         oALL :
                if (commandType = oSHOWTYPE) then
                   PrintAllParameters
                else
                   PrintMessage(INVALIDSETCOMMAND);
      end { of outer case token of }
   else
      if (commandType = oSETTYPE) then
         PrintMessage(INVALIDSETCOMMAND)
   else
      PrintMessage(INVALIDSHOWCOMMAND);
end;


{  Routine to Parse the incoming line for a valid command. }

procedure ParseInput(var commandLine : string80;
                     var commandLen : integer;
                     var runType : command);


var
    token : integer;

begin
   ScanForToken(commandLine, commandLen, token, oMAINTYPE);

   if token in [oSET, oSHOW, oSTATUS,  oHELP, oEXIT,
      oQUIT, oSEND, oRECEIVE, oQUESTIONM, oIBEX] then
      case token of
         oSET       : ParseSetShowCommand(commandLine, commandLen, oSETTYPE);
         oSHOW      : ParseSetShowCommand(commandLine, commandLen, oSHOWTYPE);
         oSEND,
         oRECEIVE  :
                     begin
                        ParseSendReceiveCommand(commandLine, commandLen,
                                                fileSpec, token);
                        if ((token = oSEND) and (sFileSpec = oON)) then
                           runType := Transmit
                        else
                           if (token = oRECEIVE) then
                              runType := Receive;
                     end;
         oSTATUS    : PrintStatus;
         oIBEX       : ExecShell(commandLine, commandLen);
         oHELP      : PrintHelpCP6(commandLine, commandLen);
         oQUESTIONM : HelpMessage(29);
         oEXIT,
         oQUIT     : exitProgram := true;
      end { of case token of }
   else
      PrintMessage(INVALIDCOMMAND);
end;


{  Routine to print command line prompt and get user input }

function CommandPrompt(var commandLine : string80;
                       var commandLen : integer) : boolean;


var
    noInput : boolean;
    j : integer;

begin
   noInput := true;

   write(KERMITPROMPT);
   while ((noInput) and (not eof)) do
      begin
         j := 1;
         while (( not eoln ) and ( j<=LARGESIZE )) do
            begin
               read (commandline[j] );
               j := j+1
            end;
         readln;
         commandLen := j-1;

         if (commandLen > 0) then
            begin
               noInput := false;
               StrUpcase(commandLine, commandLen);
               SkipBlanks(commandLine, commandLen);
            end
         else
            write(KERMITPROMPT);
      end;

   CommandPrompt := not(noInput);
end;


procedure PromptAndParseUser(var exitProgram : boolean;
                             var RunType : command);


begin

   while ( not(exitProgram) and
         not((RunType = Receive) or
         (RunType = Transmit) or
         (RunType = Connect)) ) do
      begin
         if CommandPrompt(commandLine, commandLen) then
            ParseInput(commandLine, commandLen, RunType)
         else
            exitProgram := true;
      end;

       {  Set parms that could not be set normally }
   if (debugging = oOFF) then
      debug := false
   else
      debug := true;

   if (fileEol = oLF) then
      EOLFORFILE := LineFeed
   else
      if (fileEol = oCRLF) then
         EOLFORFILE := CrLf
   else
      EOLFORFILE := JustCr;

   if (transtype = oASCII) then
      begin
         EBQstate := Ascii;
      end
   else
      begin
         EBQstate := Binary;
      end;
   if parity <> DEFPARITY then
      begin
         DEFPARITY := parity ;
         case parity of
            oNONE: set_parity (0) ;
            oODD : set_parity (1) ;
            oEVEN: set_parity (2) ;
         end {case}
      end ;
end;
begin


   KermitInit ;

   9999: { Goto for an error packet }

         RunType := Invalid;
   exitProgram := false;

   while not(exitProgram) do
      begin

         PromptAndParseUser(exitProgram, RunType);

         if not(exitProgram) then
            begin
               ResetKermitPacketNumber;
               case RunType of
                  Receive,
                  Transmit : KermitMain ;
                  Invalid,
                  Connect : {do nothing}
               end;
            end;
         RunType := Invalid;
      end;

   set_profile (1, linespeed, width, parity) ; {reset}


end.
!EOD
!PL6 ME OVER PL6_OBJ (LS)
SET_PROMPT: PROC ;
%INCLUDE CP_6;
%FPT_PROMPT (FPTN = PROMPT, PROMPT = NONE, VFC = YES) ;
DCL NONE CHAR(1) CONSTANT INIT ('@') ;
CALL M$PROMPT (PROMPT) ;
RETURN ;
END SET_PROMPT ;
%EOD ;
SET_PROFILE: PROC (MODE, SPEED, WIDTH, PARITY) ;
%INCLUDE CP_6 ;
%FPT_TRMATTR (FPTN = ATTRIBUTES, TRMATTR = VLP_TRMATTR) ;
%VLP_TRMATTR ;
%FPT_PLATEN (FPTN = PLATEN, PLATEN = VLP_PLATEN) ;
%VLP_PLATEN (WIDTH=100) ;
%F$DCB ;
DCL MODE UBIN WORD ;
DCL SPEED UBIN WORD ;
DCL WIDTH UBIN WORD ;
DCL PARITY UBIN WORD ;
IF MODE = 0 THEN
    DO ;
    CALL M$GTRMATTR (ATTRIBUTES) ;
    SPEED = VLP_TRMATTR.SPEED# ;
    WIDTH = VLP_TRMATTR.WIDTH# ;
    PARITY = VLP_TRMATTR.PARITY# ;
    VLP_TRMATTR.WIDTH# = 100 ;
    CALL M$STRMATTR (ATTRIBUTES) ;
    VLP_TRMATTR.WIDTH# = WIDTH ;
    WIDTH = DCBADDR (DCBNUM (M$UC)) -> F$DCB.WIDTH# ;
    CALL M$PLATEN (PLATEN) ;
    VLP_PLATEN.WIDTH# = WIDTH ;
    END ;
ELSE
    DO ;
    CALL M$STRMATTR (ATTRIBUTES) ;
    CALL M$PLATEN (PLATEN) ;
    END ;
RETURN ;
END ;
%EOD ;
GETLINEINPUT: PROC(INCOMING,LENGTH,BEPATIENT,RESULT);
%INCLUDE CP_6;
%FPT_READ    (FPTN                     = READ_COMM_LINE,
              DCB=F$LINE,
              TRANS=YES );
%FPT_TRMCTL  (FPTN                     = SET_TERM,
              TRMCTL=TERM);
%VLP_TRMCTL  (FPTN                     = TERM,
              ACTONTRN=YES);
%FPT_TRMPRG  (FPTN=TYPEAHEAD,DCB=M$UC,PURGEINPUT=YES);
%FPT_EOM     (FPTN                     = TIMEOUT,
              EOMTABLE=VLP_EOMTABLE,
              TIMEOUT=0,
              UTYPE=SEC );
%VLP_EOMTABLE(FPTN                     = VLP_EOMTABLE,
              VALUES=STD);
DCL F$LINE DCB ;
DCL INCOMING CHAR(LENGTH);
DCL LENGTH UBIN WORD;
DCL BEPATIENT UBIN WORD;
DCL RESULT SBIN WORD ALIGNED;

    TIMEOUT.V.TIMEOUT# = BEPATIENT ;
    CALL M$EOM( TIMEOUT );
    READ_COMM_LINE.BUF_ = VECTOR (INCOMING);
    RESULT = 1;
    CALL M$STRMCTL (SET_TERM);
/*  CALL M$TRMPRG (TYPEAHEAD); */
    CALL M$READ( READ_COMM_LINE )  ALTRET( TIMED_OUT );
    RESULT = 0;

TIMED_OUT:
    TIMEOUT.V.TIMEOUT# = 0;
    CALL M$EOM( TIMEOUT );
    RETURN;

END GETLINEINPUT;
%EOD ;
TAKE_NAP: PROC (TIME) ;
%INCLUDE CP_6;
%FPT_WAIT (FPTN = WAIT, UNITS = 25);
DCL TIME UBIN WORD ;
WAIT.V.UNITS# = TIME ;
CALL M$WAIT (WAIT) ;
RETURN ;
END TAKE_NAP ;
%EOD ;
SET_PARITY: PROC (MODE) ;
%INCLUDE CP_6 ;
%FPT_TRMATTR (FPTN = PARITY, TRMATTR = VLP_TRMATTR) ;
%VLP_TRMATTR ;
DCL MODE UBIN WORD ;
VLP_TRMATTR.PARITY# = MODE ;
CALL M$STRMATTR (PARITY) ;
RETURN ;
END ;
!EOD
!LINK KERMIT_OBJ, PL6_OBJ OVER KERMIT_RU