Columbia Kermit/kermit.zip/pub/rt11pascal/rtpar.pas

Pascal/Delphi Source File | 2020-01-01 | 33.1 KB | 1,506 lines

  { Externals called by Parse }

  FUNCTION Exists({ Using } VAR s:string): { Returning } boolean;
  EXTERNAL;

  { open (RT-11) -- open a file for reading or writing }
  FUNCTION Sopen (VAR name : string; omode : integer) : filedesc;
  EXTERNAL;

  { close (omsi) -- close a file }
  PROCEDURE Sclose (fd : filedesc);
  EXTERNAL;

  { close all files on exit }
  PROCEDURE closeall;
  EXTERNAL;

  PROCEDURE CtoS({ Using } x:cstring; { Returning } VAR s:string);
    { convert constant to STIP string }
  EXTERNAL;

  { getcf (UCB) -- get one character from file }
  FUNCTION getcf (VAR c: character; fd : filedesc) : character;
  EXTERNAL;

  { putcf (UCB) -- put a single character on file fd }
  PROCEDURE putcf (c : character; fd : filedesc);
  EXTERNAL;

  PROCEDURE GTLINE(VAR commandLine : string80);
  EXTERNAL;

  { getarg (RT-11) -- copy n-th command line argument into s }
  FUNCTION getarg (n : integer; VAR s : string;
           maxs : integer) : boolean;
  EXTERNAL;

  { number of arguments -- RT-11 }
  FUNCTION nargs : integer;
  EXTERNAL;

   { putstr (UCB) -- put out string on file }
  PROCEDURE putstr (VAR s : string; f : filedesc);
  EXTERNAL;


  PROCEDURE PutCln({ Using } x:cstring;
           { Using } fd:filedesc);
    { output literal followed by NEWLINE }
  EXTERNAL;

  PROCEDURE stiphalt; { used by external procedures for halt }
  EXTERNAL;

  { fcopy -- copy file fin to file fout }
  PROCEDURE fcopy (fin, fout : filedesc);
  VAR
    c : character;
   BEGIN
     WHILE (getcf(c, fin) <> ENDFILE) DO
     putcf(c, fout)
   END;

  PROCEDURE OverHd({ Using }  p,f: Stats;
           { Returning } VAR o:integer);

    { Calculate OverHead as % }
    { 0verHead := (p-f)*100/f }
  VAR
     temp : real;
   BEGIN
    IF (f <> 0.0) THEN
       BEGIN
        temp := (p-f)*100/f;
        o := round(temp);
       END
    ELSE
        o := 0;
   END;

  PROCEDURE CalRat({ Using } f: Stats;
           { Using } t:integer;
           { Returning } VAR r:integer);

    { Calculate Effective Baud Rate }
    { Rate = f*10/t }
  VAR
    temp : real;
   BEGIN
    IF t <> 0 THEN
       BEGIN
        temp := f*10/t;
        r := round(temp);
       END
    ELSE
        r := 0;
   END;

  { mustopen -- open file or die }
  FUNCTION mustopen (VAR name : string; mode : integer) : filedesc;
  VAR
    fd : filedesc;
   BEGIN
     fd :=Sopen(name, mode);
     IF (fd = IOERROR)
      THEN
       BEGIN
     putstr(name, STDERR);
     Putcln(': can''t open file   ',STDERR);
     stiphalt;
       END;
     mustopen := fd
   END;

  PROCEDURE Setargs;
    { Set up list of filenames for KERMIT }
  VAR
    idx : 1.. MAXSTR;
    i:integer;
    fname : string;
    junk : boolean;

   BEGIN

     cmdargs := 0;    {  initialize }
     idx := 1;

     WHILE ( cmdlin[idx]<>ENDSTR)
     DO
      BEGIN
    WHILE (cmdlin[idx] = BLANK) DO
    idx := idx+1;

    IF (cmdlin[idx]<>ENDSTR)
     THEN
      BEGIN
        cmdargs := cmdargs+1;
        cmdidx[cmdargs] := idx;
        WHILE ((cmdlin[idx]<>ENDSTR)
            AND (cmdlin[idx]<>BLANK)) DO
           idx := idx+1;
        IF (cmdlin[idx] <> ENDSTR) THEN
        BEGIN
        cmdlin[idx] := ENDSTR;
        idx := idx+1;
        END;

        IF (cmdlin[cmdidx[cmdargs]] = LESS)
         THEN
          BEGIN
        cmdidx[cmdargs] := cmdidx[cmdargs] + 1;
        junk := getarg(cmdargs,fname,MAXSTR);
        redirect[STDIN] := mustopen(fname,IOREAD);
        cmdargs := cmdargs -1
          END
         ELSE
         IF (cmdlin[cmdidx[cmdargs]] = GREATER)
          THEN
           BEGIN
         cmdidx[cmdargs] := cmdidx[cmdargs] + 1;
         junk := getarg(cmdargs,fname,MAXSTR);
         redirect[STDOUT] := mustopen(fname,IOWRITE);
         cmdargs := cmdargs -1
           END

      END
      END
   END;

  { Beginning of PARSER }
  { Based on the Parser in the VAX KERMIT by Bruce Pinn (UTCS) }


  {$E+}
  PROCEDURE PromptAndParseUser(VAR exitProgram : boolean;
                   VAR RunType : command);
  CONST


{ CONSTANTS for    Parser }

    NULL = -1;
    RANGENULL = -2;

    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;

    uSET = 3;
    uMSEND = 3;
    uMRECEIVE = 1;
    uSHOW =    2;
    uSTATUS    = 2;
    uCONNECT = 1;
    uHELP =    1;
    uQUESTION = 1;
    uEXIT =    1;
    uQUIT =    1;
    uSEND =    1;
    uRECEIVE = 1;
    uDEBUGGING = 3;
    uFILEWARNING = 1;
    uFILERECORD = 5;
    uEIGHTBIT = 2;
    uLOCALECHO = 2;
    uLINE =    2;
    uESCAPE    = 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;
    uCLF = 2;
    uPARITY    = 1;
    uEVEN =    1;
    uODD = 1;
    uNONE =    1;
    uSPEED = 2;
    uVERBOSE = 1;
    uTESTING = 1;


    oSET = 0;
    oSHOW =    1;
    oSTATUS    = 2;
    oCONNECT = 3;
    oHELP =    4;
    oEXIT =    5;
    oQUIT =    6;
    oSEND =    7;
    oRECEIVE = 8;
    oDEBUGGING = 9;
    oFILEWARNING = 10;
    oLOCALECHO = 11;
    oLINE =    12;
    oESCAPE    = 13;
    oDELAY = 14;
    oPACKETLENGTH =    15;
    oPADDING = 16;
    oPADCHAR = 17;
    oTIMEOUT = 18;
    oENDOFLINE = 19;
    oQUOTE = 20;
    oQUESTIONM = 23;
    oALL = 24;
    oBADTOKEN = 25;
    oFILERECORD = 26;
    oCR = 27;
    oLF = 28;
    oCLF = 29;
    oPARITY    = 30;
    oSPEED = 34;
    oVERBOSE = 35;
    oTESTING = 36;
    oEIGHTBIT = 37;

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

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

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

    cBADTOKEN    = 'XX           ';
    cSET        = 'SET          ';
    cSHOW        = 'SHOW         ';
    cSTATUS        = 'STATUS       ';
    cCONNECT    = 'CONNECT      ';
    cHELP        = 'HELP         ';
    cEXIT        = 'EXIT         ';
    cQUIT        = 'QUIT         ';
    cQUESTION    = '?            ';
    cSEND        = 'SEND         ';
    cRECEIVE    = 'RECEIVE      ';
    cDEBUGGING    = 'DEBUGGING    ';
    cFILEWARNING    = 'FILE-WARNING ';
    cLOCALECHO    = 'LOCAL-ECHO   ';
    cLINE        = cBADTOKEN;
    cESCAPE        = cBADTOKEN;
    cDELAY        = 'DELAY        ';
    cPACKETLENGTH    = 'PACKET-LENGTH';
    cPADDING    = 'PADDING      ';
    cPADCHAR    = 'PADCHAR      ';
    cTIMEOUT    = 'TIMEOUT      ';
    cENDOFLINE    = 'END-OF-LINE  ';
    cQUOTE        = 'QUOTE        ';
    cALL        = 'ALL          ';
    cON        = 'ON           ';
    cOFF        = 'OFF          ';
    cEIGHTBIT    = 'EIGHT-BIT    ';
    cFILERECORD    = cBADTOKEN;
    cCR        = 'CR           ';
    cLF        = 'LF           ';
    cCLF        = 'CLF          ';
    cPARITY        = 'PARITY       ';
    cEVEN        = 'EVEN         ';
    cODD        = 'ODD          ';
    cNONE        = 'NONE         ';
    cSPEED        = cBADTOKEN;
    cVERBOSE    = 'VERBOSE      ';
    cTESTING    = 'TESTING      ';

  PROCEDURE SetEchoAndParity;
   VAR
      tempecho,tempparity : integer;
  BEGIN

       IF (localEcho = oON)
    THEN tempecho := 1
    ELSE
    tempecho := 0;

       IF parity = oNONE
    THEN tempparity := -1
    ELSE
    IF parity = oEVEN
     THEN  tempparity := 0
     ELSE tempparity := 1;

{$C
    .GLOBL    PARFLG
    .GLOBL    ECHO
    MOV    tempecho(SP),ECHO
    MOV    tempparity(SP),PARFLG
}
   END;


    {  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 : integer;
      endOfString : boolean;

     BEGIN

       i := 1;
       endofString := false;
       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;

       commandLen := commandLen - i;
     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);


    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 - 1);
     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 writeln for main menu.  }
    PROCEDURE PrintMainHelp;
     BEGIN
       writeln('  send <filename(s)>');
       writeln('  receive [<filename>]');
       writeln('  status');
       writeln('  connect');
       writeln('  set  <option>');
       writeln('  show <option>');
       writeln('  help');
       writeln('  exit | quit');
       writeln('  ?');
     END;



    {  Print the ? help writeln for set menu. }
    PROCEDURE PrintSetHelp;
     BEGIN
       writeln('  send  <option>');
       writeln('  receive <option>');
       writeln('  debugging <on | OFF>');
       writeln('  file-warning <ON | off>');
       { writeln('  filerecord <CLF | lf | cr>'); }
       writeln('  eight-bit <ON | off>');
       writeln('  local-echo <on | OFF>');
       writeln('  parity <none | EVEN | odd>');
       { writeln('  speed  <d>');
        writeln('  line   <d>');
    writeln('  escape <o>'); }
       writeln('  delay  <d>');
       writeln('  ?');
     END;


    {  Print the ? help writeln for show menu. }
    PROCEDURE PrintShowHelp;
     BEGIN
       writeln('  send  <option>');
       writeln('  receive <option>');
       writeln('  debugging');
       writeln('  file-warning');
       { writeln('  filerecord'); }
       writeln('  eight-bit');
       writeln('  local-echo');
       { writeln('  line');
    writeln('  escape'); }
       writeln('  delay');
       writeln('  all');
       writeln('  ?');
     END;


    {  Print the ? help writeln for set send/receive menu. }
    PROCEDURE PrintSetSendReceiveHelp;
     BEGIN
       writeln('  packet-length <d>');
       writeln('  padding <d>');
       writeln('  padchar <o>');
       writeln('  timeout <d>');
       writeln('  end-of-line   <o>');
       writeln('  quote   <c>');
     END;


    {  Print the ? help writeln for show send/receive menu. }
    PROCEDURE PrintShowSendReceiveHelp;
     BEGIN
       writeln('  packet-length');
       writeln('  padding');
       writeln('  padchar');
       writeln('  timeout');
       writeln('  end-of-line');
       writeln('  quote');
     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;
       writeln('  Run Time =                    ', RunTime : STRWIDTH);

       IF (oldRunType = Transmit)
    THEN
    CalRat(ChInFileSend, RunTime, effectiveRate)
    ELSE
    CalRat(ChInFileRecv, RunTime, effectiveRate);
       writeln('  Effective Baud Rate =         ', effectiveRate : STRWIDTH);

     END;


    {  Print the writeln 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(' ? Help file does not exist');
     SENDPARMS :
     writeln('Send Parameters:');
     RECEIVEPARMS :
     writeln('Receive Parameters:');
     LOCALPARMS :
     writeln('Local System Parameters:');
     BLANKLINE :
     writeln(' ');
    END;
     END;


    {  Routine to type the help file. }
    PROCEDURE PrintHelpFile;

    VAR
      s : string;
      hfile : filedesc;
     BEGIN
       CtoS( 'KERMIT.HLP          ',s);
       IF Exists(s)
    THEN
     BEGIN
       hfile := Sopen(s,IOREAD);
       fcopy(hfile,STDOUT);
       Sclose(hfile);
     END
    ELSE
    PrintMessage(NOHELPAVAILABLE);
     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 : -2,' (oct)');
     oTIMEOUT :
     writeln('  Time-out length =       ', value : 2,' (sec)');
     oENDOFLINE :
     writeln('  End of Line Character = ', value : -2,' (oct)');
     oQUOTE :
     writeln('  Quote Character =       ', 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 } ;
     oFILEWARNING :
      BEGIN
        write('  File Warning =          ');
        IF (value = oOFF)
         THEN
         writeln('off')
         ELSE
         writeln('on');
      END;
     oEIGHTBIT :
      BEGIN
        write('  Eight-Bit Quoting =     ');
        IF (value = oOFF)
         THEN
         writeln('off')
         ELSE
         writeln('on');
      END;
     oLOCALECHO :
      BEGIN
        write('  Local Echo =            ');
        IF (value = oOFF)
         THEN
         writeln('off')
         ELSE
         writeln('on');
      END;
     oDELAY :
     writeln('  Delay =                 ', value : 2,' (sec)');
     oDEBUGGING :
      BEGIN
        write('  Debugging =             ');
        IF NOT debug
         THEN
         writeln('off')
         ELSE
         writeln('on');
        IF verbosity
         THEN
         writeln('  Verbosity');
        IF OneWayOnly
         THEN
         writeln('  Test Mode');
      END;
     oPARITY :
      BEGIN
        write('  Parity =                ');
        IF (value = oEVEN)
         THEN
         writeln('even')
         ELSE
         IF (value = oODD)
          THEN
          writeln('odd')
          ELSE
          writeln('none');
      END;
     oSPEED,
     oESCAPE,
     oLINE:
     PrintMessage(NOTIMPLEMENTED);
    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;
      xx : 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;
    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 = NULL)
     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(BLANKLINE);
       PrintMessage(LOCALPARMS);
       PrintParmValue(fileWarn, oFILEWARNING);
       { PrintParmValue(fileEol, oFILERECORD);  }
       PrintParmValue(eightBitQuoting,oEIGHTBIT);
       PrintParmValue(localEcho, oLOCALECHO);
       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;
                      token : integer);

    VAR
      dummy ,gotafile : boolean;
      i : integer;
      tempfile : string;
     BEGIN

       IF ((commandLine[1] <> ' ') AND (commandLen > 0))
    THEN
     BEGIN
       { copy and set up arguments }

       FOR i := 1 TO commandLen DO
       cmdlin[i] := ord(commandLine[i]);
       cmdlin[commandLen + 1] := ENDSTR;
       setargs;

       { Check to see if we have any files to send }

       gotafile := false;
       nextarg := 1;

       WHILE((NOT gotafile) AND (nextarg <= nargs)) DO
        BEGIN
          dummy := getarg(nextarg,tempfile,MAXSTR);
          gotafile := Exists(tempfile);
          nextarg := nextarg + 1;
        END;

       nextarg := 1;

       CASE token OF
         oSEND:
             IF gotafile THEN
                sFileSpec := oON
             ELSE
               BEGIN
                sFileSpec := oOFF;
                    PrintMessage(INVALIDFILESPEC);
               END;
         ELSE
         rFileSpec := oON;
        END;
     END
    ELSE
    IF (token = oSEND)
     THEN
      BEGIN
        sFileSpec := oOFF;
        PrintMessage(INVALIDFILESPEC);
      END
     ELSE
     rFileSpec := oOFF;

     END;


    {  Get a valid token form the command line and return it. }
    PROCEDURE ScanForToken(VAR commandLine : string80;
               VAR commandLen, token : integer;
               typeToken : integer);


    VAR
      tempToken : string13;
      totChars : integer;

     BEGIN

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

       token := NULL;
       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, cCONNECT, totChars, uCONNECT))
          THEN
          token := oCONNECT
          ELSE
          IF (CompareStr(tempToken, cSEND, totChars, uMSEND))
           THEN
           token := oSEND
           ELSE
           IF (CompareStr(tempToken, cRECEIVE, totChars, uMRECEIVE))
        THEN
        token := oRECEIVE
        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, cDEBUGGING, totChars, uDEBUGGING))
         THEN
         token := oDEBUGGING
         ELSE
         IF (CompareStr(tempToken, cFILEWARNING, totChars, uFILEWARNING))
          THEN
          token := oFILEWARNING
          ELSE
          IF (CompareStr(tempToken, cFILERECORD, totChars, uFILERECORD))
           THEN
           token := oFILERECORD
           ELSE
           IF (CompareStr(tempToken, cLOCALECHO, totChars, uLOCALECHO))
        THEN
        token := oLOCALECHO
        ELSE
           IF (CompareStr(tempToken, cEIGHTBIT, totChars, uEIGHTBIT))
        THEN
        token := oEIGHTBIT
        ELSE
        IF (CompareStr(tempToken, cLINE, totChars, uLINE))
         THEN
         token := oLINE
         ELSE
         IF (CompareStr(tempToken, cESCAPE, totChars, uESCAPE))
          THEN
          token := oESCAPE
          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;

      oDEBUGTYPE:
      IF (CompareStr(tempToken, cOFF, totChars, uOFF))
       THEN
        BEGIN
          debug := false;
          verbosity := false;
          OneWayOnly := false;
        END
       ELSE
          IF (CompareStr(tempToken, cON, totChars, uON))
        THEN
        debug := true
        ELSE
           IF (CompareStr(tempToken, cVERBOSE, totChars, uVERBOSE))
         THEN
         verbosity := true
         ELSE
           IF (CompareStr(tempToken, cTESTING, totChars, uTESTING))
          THEN
          OneWayOnly := true;
      oFILEWARNTYPE,
    oEIGHTBITTYPE,
      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, cCLF, totChars, uCLF)) then
       token := oCLF } ;

      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;

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

       CASE token OF
     oSEND    :
      BEGIN
        ScanForToken(commandLine, commandLen, token, oSENDTYPE);
        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;
          ELSE
          IF (commandType = oSETTYPE)
           THEN
           PrintMessage(INVALIDSETCOMMAND)
           ELSE
           PrintMessage(INVALIDSHOWCOMMAND);
         END;
      END;

     oRECEIVE :
      BEGIN
        ScanForToken(commandLine, commandLen, token, oRECEIVETYPE);
        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;
          ELSE
          IF (commandType = oSETTYPE)
           THEN
           PrintMessage(INVALIDSETCOMMAND)
           ELSE
           PrintMessage(INVALIDSHOWCOMMAND);
         END;
      END;

     oDEBUGGING :
      BEGIN
        ScanForToken(commandLine, commandLen, value, oDEBUGTYPE);
      END;
     oFILEWARNING :
      BEGIN
        ScanForToken(commandLine, commandLen, value, oFILEWARNTYPE);
        TestAndSetValue(value, fileWarn, token, commandType);
      END;
     oFILERECORD :
         {  begin
          ScanForToken(commandLine, commandLen, value, oFILERECTYPE);
          TestAndSetValue(value, fileEOL, token, commandType);
      end } ;
     oLOCALECHO :
      BEGIN
        ScanForToken(commandLine, commandLen, value, oLOCECHOTYPE);
        TestAndSetValue(value, localEcho, token, commandType);
      END;
     oEIGHTBIT:
      BEGIN
        ScanForToken(commandLine, commandLen, value, oEIGHTBITTYPE);
        TestAndSetValue(value, eightBitQuoting, token, commandType);
      END;
     oPARITY :
      BEGIN
        ScanForToken(commandLine, commandLen, value, oPARITYTYPE);
        TestAndSetValue(value, parity, token, commandType);
      END;
     oSPEED,
     oLINE,
     oESCAPE :
     PrintMessage(NOTIMPLEMENTED);
     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);
     ELSE
     IF (commandType = oSETTYPE)
      THEN
      PrintMessage(INVALIDSETCOMMAND)
      ELSE
      PrintAllParameters;
    END;
     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);

       CASE token OF
     oSET       : ParseSetShowCommand(commandLine, commandLen, oSETTYPE);
     oSHOW      : ParseSetShowCommand(commandLine, commandLen, oSHOWTYPE);
     oSEND,
     oRECEIVE  :
      BEGIN
        ParseSendReceiveCommand(commandLine, commandLen,token);
        IF ((token = oSEND) AND (sFileSpec = oON))
         THEN
         runType := Transmit
         ELSE
         IF (token <> oSEND)
          THEN
          runType := Receive;
      END;
     oSTATUS    : PrintStatus;
     oCONNECT   : runType := Connect;
     oHELP      : PrintHelpFile;
     oQUESTIONM : PrintMainHelp;
     oEXIT,
     oQUIT     : exitProgram := true;
     ELSE
     PrintMessage(INVALIDCOMMAND);
    END;
     END;


    {  Routine to print command line prompt and get user input }
    FUNCTION CommandPrompt(VAR commandLine : string80;
               VAR commandLen : integer) : boolean;


    VAR
      noInput : boolean;

     BEGIN
       noInput := true;
       WHILE (noInput) DO
    BEGIN
      GTLINE(commandLine);
      commandLen := LenString(commandLine);

      IF (commandLen > 0)
       THEN
        BEGIN
          noInput := false;
          StrUpcase(commandLine, commandLen);
        END
    END;

       CommandPrompt := NOT(noInput);
     END;

    { Start of main procedure }

   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 (fileEol = oLF) then
      EOLFORFILE := LineFeed
      else if (fileEol = oCLF) then
      EOLFORFILE := CrLf
      else
      EOLFORFILE := JustCr;
      }

     IF (fileWarn = oOFF)
      THEN
      fileWarning := false
      ELSE
      fileWarning := true;

     IF (eightBitQuoting = oOFF)
      THEN
      Def8QuoteMode := TYPEY
      ELSE
      Def8QuoteMode := AMPER;

     SetEchoAndParity;

   END;