(* <<<Connect232.Pas>>> *)
MODULE Connect232 ;
 
(*)
 *  A communications routine via the RS232 line to another host.
 *  Parameters are:
 *
 *      EscChar         The "escape" character, when this character is read
 *                      from the keyboard return to caller.
 *      HalfDuplex      The state of the host's connection, if HalfDuplex is
 *                      true echo the keyboard characters locally.
 *      TabletOk        If true, the yellow button on the puck causes an
 *                      exit too.
                        5-Oct-83. Change cursor shape and allow ANY puck button
                        to cause an exit.
 *      RETURN:         ConCharExit    if <EscChar> caused exit,
 *                      ConButtonExit  for puck button.
(*)
 
EXPORTS    (*-------------*)
 
IMPORTS IO_Unit   FROM IO_Unit;
IMPORTS IOErrors  FROM IOErrors;
 
TYPE
    (* What caused "Connect" to exit *)
    ConExitFlag = (ConCharExit, ConButtonExit) ;


FUNCTION Connect( EscChar: Char; HalfDuplex, TabletOk: Boolean ) : ConExitFlag;
 
 
PRIVATE   (*---------------*)
 
IMPORTS Screen    FROM Screen ;
IMPORTS System    FROM System ;
IMPORTS IO_Others FROM IO_Others;

FUNCTION Connect( EscChar: Char; HalfDuplex, TabletOk: Boolean ) : ConExitFlag;
   CONST
      NUL =   Chr(#000) ;
      BS  =   Chr(#010) ;
      TAB =   Chr(#011) ;
      LF  =   Chr(#012) ;
      CR  =   Chr(#015) ;
      CtrlQ = Chr(#021) ;
      CtrlS = Chr(#023) ;
   VAR
      hpos:  Integer ;   (* current position in the line (for tabs) *)
      oldX, oldY: Integer ;    (* Old cursor offsets *)
      quit:  Boolean ;         (* loop control *)
      LineChr, KeyChr:  Char;  (* current RS232 and keyboard characters *)
      OldCurs, NewCurs: CurPatPtr ;  (* Old and New cursors (if TabletOk) *)
      return: ConExitFlag ;    (* the exit flag *)
 
   PROCEDURE WriteChr( c: Char ) ;
      BEGIN
         SPutChr( c ) ;
         Hpos := Hpos + 1
      END ;
 
   HANDLER CtlC ;
      BEGIN
      END ;
 
   BEGIN  (*-Connect-*)

      (* Allocate cursor space *)
      New( 0, 4, NewCurs) ;
      New( 0, 4, OldCurs) ;

      (* Clear the cursor area *)
      RasterOp(RXor, 64, 64, 0, 0, 4, RECAST(NewCurs, RasterPtr),
                             0, 0, 4, RECAST(NewCurs, RasterPtr) ) ;
 
(* Cursor values from file: Connect3.Cursor *)
      NewCurs^[ 0,0] := #40 ;
      NewCurs^[ 1,0] := #120 ;
      NewCurs^[ 1,1] := #1642 ;
      NewCurs^[ 1,2] := #167000 ;
      NewCurs^[ 2,0] := #210 ;
      NewCurs^[ 2,1] := #1024 ;
      NewCurs^[ 2,2] := #42000 ;
      NewCurs^[ 3,0] := #404 ;
      NewCurs^[ 3,1] := #1610 ;
      NewCurs^[ 3,2] := #42000 ;
      NewCurs^[ 4,0] := #1002 ;
      NewCurs^[ 4,1] := #1024 ;
      NewCurs^[ 4,2] := #42000 ;
      NewCurs^[ 5,0] := #404 ;
      NewCurs^[ 5,1] := #1642 ;
      NewCurs^[ 5,2] := #162000 ;
      NewCurs^[ 6,0] := #2211 ;
      NewCurs^[ 7,0] := #5122 ;
      NewCurs^[ 7,1] := #100000 ;
      NewCurs^[ 8,0] := #10444 ;
      NewCurs^[ 8,1] := #40000 ;
      NewCurs^[ 9,0] := #20210 ;
      NewCurs^[ 9,1] := #20000 ;
      NewCurs^[10,0] := #40120 ;
      NewCurs^[10,1] := #10000 ;
      NewCurs^[11,0] := #20210 ;
      NewCurs^[11,1] := #20000 ;
      NewCurs^[12,0] := #10444 ;
      NewCurs^[12,1] := #40000 ;
      NewCurs^[13,0] := #5122 ;
      NewCurs^[13,1] := #100000 ;
      NewCurs^[14,0] := #2211 ;
      NewCurs^[15,0] := #404 ;
      NewCurs^[16,0] := #1002 ;
      NewCurs^[17,0] := #404 ;
      NewCurs^[18,0] := #210 ;
      NewCurs^[19,0] := #120 ;
      NewCurs^[20,0] := #40 ;
 

      (* Debug :- %)
      Writeln('TabletOk = ', TabletOk) ;
      (% Debug    *)


      SCurOn ;  (* ? *)


      (* Set up our cursor, or turn the cursor off if we can't use a cursor *)
      IF TabletOk THEN
         BEGIN
            IOReadCursPicture( OldCurs, oldX, oldY ) ;
            IOLoadCursor( NewCurs, 0, 0) ;
            IOSetModeTablet( relTablet ) ;
            IOCursorMode( TrackCursor )
         END
      ELSE
         IOCursorMode( OffCursor ) ;  (* Turn it off *)

      return := ConCharExit ;  (* Assume the exit by escape char *)
      quit := False ;
      WHILE NOT quit DO
         BEGIN
            (*----------   RS232 Input   ----------*)
            IF (IOCRead(RS232In, LineChr)=IOEIOC)  THEN
               BEGIN
                  LineChr := Chr( Land( Ord(LineChr), #177) ) ;
                  IF (LineChr = TAB) THEN
                     BEGIN
                        WriteChr( ' ' ) ;
                        WHILE (Hpos MOD 8) <> 0 DO  WriteChr( ' ' )
                     END
                  ELSE
                     IF (LineChr = BS) THEN
                        BEGIN
                           IF Hpos > 0 THEN
                              BEGIN (* Delete the character *)
                                 SBackSpace( ' ' );
                                 SPutChr( ' ' ) ;
                                 SBackSpace( ' ' ) ;
                                 Hpos := Hpos - 1
                              END
                        END
                     ELSE
                        IF (LineChr IN [NUL, CtrlS, CtrlQ]) THEN (* NOTHING *)
                        ELSE
                           WriteChr( LineChr ) ;   (* write it *)
 
                  IF (LineChr IN [CR, LF]) THEN  Hpos := 0 ;  (* a new line *)
               END ; (* RS232 input *)
 
            (*----------   Keyboard Input   ----------*)
            IF (IOCRead(TransKey, KeyChr)=IOEIOC) THEN
               BEGIN
                  IF (KeyChr = EscChar) THEN
                     BEGIN
                        quit := True
                     END
                  ELSE
                     BEGIN
                        IF IOCWrite(RS232Out, KeyChr)<>IOEIOC THEN
                           KeyChr := Chr(#277) ;
                        IF HalfDuplex THEN WriteChr( KeyChr )
                     END
               END ; (* Keyboard input *)
 
            (*----------   Tablet Input   ----------*)
            IF TabletOk AND TabSwitch THEN 
              BEGIN
                return := ConButtonExit ;
                quit := True
              END

         END ; (* while *)

      (* Restore cursor *)
      IF TabletOk THEN IOLoadCursor( OldCurs, oldX, oldY )
      ELSE IOCursorMode( TrackCursor ) ; (* I assume it was originally on *)
      Dispose( NewCurs ) ;

      Connect := return
   END .  (*-Connect-*)

(* <<<Kermit.Pas>>> *)
PROGRAM Kermit(Input,Output);
(*)
 * 29-Nov-83 Allow eight bit file transfer with SET EIGHT-BIT ON/OFF
 *           add global flag and extra SET command   [pgt001]
 *           For byte value 0..255 the end of (data) string value is now -1,
 *           and end of file value -2.
 *  1-Dec-83 Place all globals into module KermitGlobals.
(*)
 
 
 
IMPORTS Stdio           FROM Stdio ;
IMPORTS KermitGlobals   FROM KermitGlobals ; (**********)
IMPORTS KermitUtils     FROM KermitUtils ;
IMPORTS KermitParms     FROM KermitParms ;
IMPORTS KermitHelp      FROM KermitHelp ;
IMPORTS KermitError     FROM KermitError ;
IMPORTS KermitSend      FROM KermitSend ;
IMPORTS KermitRecv      FROM KermitRecv ;
 
IMPORTS Connect232      FROM Connect232 ;
IMPORTS PMatch          FROM PMatch ;
IMPORTS PopCmdParse     FROM PopCmdParse ;
IMPORTS Perq_String     FROM Perq_String ;
IMPORTS Screen          FROM Screen ;
IMPORTS IO_Unit         FROM IO_Unit ;
IMPORTS IOErrors        FROM IOErrors;
IMPORTS IO_Others       FROM IO_Others;
IMPORTS System          FROM System;
IMPORTS Sleep           FROM Sleep;
 
 
 
 

 
   (* Handle ^C's from the console -pt*)
HANDLER CtlC ;
   BEGIN   (*-CtlC-*)
      IOKeyClear ;             (* Remove ^C from input stream *)
      CtrlCPending := False ;  (* Clear to prevent next ^C from aborting job *)
      FromConsole := AbortNow  (* Set our flag *)
   END ;   (*-CtlC-*)
 
 
HANDLER HelpKey(VAR str: Sys9s) ;
   (* Make the HELP key generate the correct command (i.e. not a switch) -pt*)
   BEGIN  (*-HelpKey-*)
      str := 'HELP ' ;
      str[5] := Chr( CR )
   END ;  (*-HelpKey-*)

PROCEDURE OverHd( p,f: Stats;
                 VAR o:Integer);
 
   (* Calculate OverHead as % *)
   (* OverHead := (p-f)*100/f *)
 
   BEGIN
      IF (f = 0.0) THEN o := 0
      ELSE o := Round( (p-f)*100/f )
   END;
 
PROCEDURE CalRat(f: Stats;
                 t:Integer;
                 VAR r:Integer);
 
   (* Calculate Effective Baud Rate *)
   (* Rate = f*10/t *)
 
   BEGIN
      IF (t = 0) THEN r := 0
      ELSE r := Round( f*10/t )
   END;


PROCEDURE Statistics ;
   VAR
      overhead, effrate : Integer;
   BEGIN  (*-Statistics-*)
      (* print info on number of packets etc *)
      (* All output here was originally to STDERR  -pt*)
      Writeln ;
      Writeln('Packets sent:     ',NumSendPacks:1);
      Writeln('Packets received: ',NumRecvPacks:1);

      (* Calculate overhead *)
      OverHd(ChInPack,ChInFile,overhead);
      IF (Overhead <> 0) THEN
         BEGIN
            Writeln('Overhead (%):     ' ,overhead:1);
         END;
      IF (RunTime <> 0) THEN
         BEGIN (* calculate effective rate *)
            CalRat(ChInFile,RunTime,effrate);
            Writeln('Effective Rate:   ',effrate:1);
         END;

      (* Transmit stats *)
      Inverse( TRUE ) ;
      Writeln(' Send :-') ;
      Inverse( FALSE ) ;
      Writeln('Number of ACK:    ',NumACKrecv:1);
      Writeln('Number of NAK:    ',NumNAKrecv:1);
      Writeln('Number of BAD:    ',NumBADrecv:1);

      (* Transmit stats *)
      Inverse( TRUE ) ;
      Writeln(' Receive :-') ;
      Inverse( FALSE ) ;
      Writeln('Number of ACK:    ',NumACK:1);
      Writeln('Number of NAK:    ',NumNAK:1);
      Writeln
   END ; (*-Statistics-*)
 
PROCEDURE FinishUp; (* do any End of Program clean up *)
   BEGIN
      Sclose(DiskFile);
      SYSfinish;  (* do System dependent *)
   END;
 


PROCEDURE DoConnect ;
   (* Connect to the other host -pt*)
   VAR
      whyExit: ConExitFlag ; (* Why "connect" exited *)
      ch: Char ;  (* the character after the "escape" char *)
   BEGIN (*-DoConnect-*)
      Writeln('[Connecting to host. Type Control-', EscPrint,
              ' C   or any button on the puck]') ;
      REPEAT
         whyExit := Connect( EscapeChar, HalfDuplex, TRUE) ;
         (* Get the command *)
         IF (whyExit = ConButtonExit) THEN (* the button was pressed *)
            BEGIN
               Nap( 10 ) ;
               ch := 'C'  (* Close the connection *)
            END
         ELSE
            WHILE (IOCRead(TransKey, ch) <> IOEIOC) DO ;

         IF (ch = EscapeChar) THEN XmtChar( EscapeChar )
         ELSE
            IF (ch = '?') THEN
               BEGIN
                  Writeln ;
                  Writeln('When CONNECT''ed to another host, type Control-', EscPrint) ;
                  Writeln('followed by :-') ;
                  Writeln('  C    to close the connection') ;
                  Writeln('  ^', EscPrint, '   to send that character') ;
                  Writeln('  ?    for this information') ;
                  Writeln('[Back to host]')
               END (* help *)

      UNTIL (Uppercase(ch) = 'C') ;
      Writeln ;
      Writeln('[Connection closed. Returning to PERQ]')
   END ; (*-DoConnect-*)

BEGIN
   StdIOInit;
   SYSinit;             (*  system dependent  *)
   done:=False;
 
   Writeln ;
   REPEAT
 
      KermitInit;       (* initialize *)
 
      WHILE NOT (RunType IN [transmit, receive, setparm]) AND (NOT done)
      DO
         BEGIN
            CmdIndex := GetCmdLine(NullIdleProc,  'Kermit-PQ',
                                   CmdLine, CmdSpelling,
                                   Inf, RECAST(MainMenu, pNameDesc),
                                   firstPress, OK_to_pop) ;
            ConvUpper( CmdSpelling ) ; (* Make it upper case *)
            (* see what the command was *)
            CASE  CmdIndex  OF
               1:  DoConnect ;          (* CONNECT *)
               2:  done := True ;       (* EXIT *)
               3:  DoHelp ;             (* HELP *)
               4:  done := True ;       (* QUIT *)
               5:  RunType := Receive ; (* RECEIVE *)
               6:  RunType := Transmit; (* SEND *)
               7:  RunType := SetParm ; (* SET  *)
               8:  DoShow ;             (* SHOW *)
               9:  Statistics ;         (* STATISTICS *)
 
               10:  Writeln('%Not a KERMIT command: ', CmdSpelling) ;
               11: Writeln('%Ambiguous command: ', CmdSpelling) ;
               12: (* empty line *) ;
               13: Writeln('%KERMIT does not take switches, type HELP.');
               14: Writeln('?Illegal character after command') ; (* ?? *)
               OTHERWISE: Writeln('?Unknown command: ', CmdSpelling)
               END  (* case *)
         END;
 
      CASE RunType OF
         Receive:
            BEGIN (* filename is optional here *)
               (* Remove blanks from the cmd line *)
               IF (CmdLine <> '') THEN RemDelimiters( CmdLine, ' ', dumStr) ;
               IF GetArgument(aline) THEN
                  BEGIN
                     IF Exists(aline) AND FileWarning THEN
                        BEGIN
                           ErrorMsg('Overwriting: ');
                           ErrorStr(aline);
                        END;

                     IF EightBitFile THEN  (* [pgt001] *)
                        DiskFile := Sopen(aline,StdIO8Write)
                     ELSE
                        DiskFile := Sopen(aline,StdIOWrite);

                     IF (DiskFile <= StdIOError) THEN
                        ErrorPack('Cannot Open File');
                  END;
               RecvSwitch;
            END;
 
         Transmit:
            BEGIN  (* New version -pt*)
               (* must give file name, so ask if one was not given -pt*)
               IF (CmdLine = '') THEN
                  BEGIN
                     Write('File to transmit ', PromptChar) ;
                     Readln( CmdLine )  (* get the response *)
                  END ;
 
               (* What shall we do with the line ? *)
               (* First remove blanks *)
               RemDelimiters( CmdLine, ' ', dumStr) ;
               IF (CmdLine = '') THEN (* another empty line, do nothing *)
               ELSE
                  IF IsPattern(CmdLine) THEN
                     Writeln('%SEND does not take wild file names')
                  ELSE
                     SendSwitch (* SendFile checks parameters - file exists *)

            END;
         Invalid:        (* nothing *);
         SetParm:  SetParameters ;
      END;
      (* case *)
 
   UNTIL done;
 
   FinishUp; (* End of Program *)
 
   ScreenReset  (* Clear up screen data *)
END.

(* <<<KermitError.Pas>>> *)
MODULE KermitError ;
 
 
 
EXPORTS
 
IMPORTS KermitGlobals      FROM KermitGlobals ;


PROCEDURE ErrorMsg(msg:MsgString ) ;
PROCEDURE ErrorInt( msg:MsgString; n: Integer ) ;
PROCEDURE ErrorStr( str: istring ) ;
PROCEDURE DebugPacket(mes : MsgString;
                      VAR p : Ppack);
PROCEDURE Verbose(c:MsgString);
 

PRIVATE
 
IMPORTS Screen          FROM Screen ;
 
 
PROCEDURE ErrorMsg(msg:MsgString ) ;
   (* output literal preceeded by NEWLINE *)
   (* to the PERQ error window  -pt*)
   BEGIN (*-ErrorMsg-*)
      ChangeWindow( ErrorWindow ) ;
      Writeln ;
      Write( msg ) ;
      ChangeWindow( KermitWindow )
   END; (*-ErrorMsg-*)
 
PROCEDURE ErrorInt( msg:MsgString; n: Integer ) ;
   (* Output a number preceeded by a message *)
   (* to the PERQ error window  -pt*)
   BEGIN (*-ErrorInt-*)
      ChangeWindow( ErrorWindow ) ;
      Writeln ;
      Write( msg, n:1 ) ;
      ChangeWindow( KermitWindow )
   END; (*-ErrorInt-*)
 
PROCEDURE ErrorStr( str: istring ) ;
   (* Output a "istring" to the error window *)
   VAR i: Integer ;
   BEGIN (*-ErrorStr-*)
      ChangeWindow( ErrorWindow ) ;
      i := 1 ;
      WHILE str[i] <> ENDSTR DO
        BEGIN
           IF (str[i] = LF) THEN Writeln
           ELSE Write(  Chr(str[i])  ) ;
           i := i + 1
        END ;
      ChangeWindow( KermitWindow )
   END ; (*-ErrorStr-*)
 
 
PROCEDURE DebugPacket(mes : MsgString;
                       VAR p : Ppack);
   (* Print Debugging Info, into the error window -pt*)
   VAR
      i: Integer ;   (* index into data field -pt*)
   BEGIN        (*-DebugPacket-*)
      ChangeWindow( ErrorWindow ) ;  (* Print all this in error window -pt*)
      Writeln ;
      Write(mes);
      WITH Buf[p] DO
         BEGIN
            Write( '(count:', count-#40:1 ) ; (* local "UnChar" *)
            Write( ') (seq:', seq-#40:1 ) ;
            Writeln( ') (type:',  Chr(ptype), ')' );
            (* Write out the data field, straight to the screen -pt*)
            i := 1 ;
            WHILE (data[i] <> ENDSTR) DO
               BEGIN
                  Write( Chr(data[i]) ) ;
                  i := i + 1
               END ;
            Writeln ;
            (* done -pt*)
         END;
      ChangeWindow( KermitWindow )  (* back to kermit -pt*)
   END;         (*-DebugPacket-*)
 
 
PROCEDURE Verbose(c:MsgString);
   (* Print writeln if verbosity *)
   BEGIN
      IF Verbosity THEN ErrorMsg(c);
   END.

(* <<<KermitGlobals.Pas>>> *)
MODULE KermitGlobals;

(*)
 * 1-Dec-83.
 *  Split the Kermit program file into: KermitGlobals which contains all
 *  global information, and Kermit.Pas which is the main program file.
 *  this allow all the kermit modules to be used by any other program.
(*)

EXPORTS
 
IMPORTS CmdParse        FROM CmdParse ;
IMPORTS SystemDefs      FROM SystemDefs ;

CONST
 
 
   (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
   KermitWindow = 1 ;  (* Window numbers - See SysInit for their creation -pt*)
   ErrorWindow  = 2 ;  (* An error window for all messages and errors     -pt*)
   FF = Chr(#014) ;    (* A form feed to clear the windows -pt*)
   PromptChar = Chr(#032) ; (* PERQ character set: grey arrow head -pt*)
   OK_to_Pop = True ;  (* Allow pop-up menus -pt*)
   MaxPopCmds = 10 ;   (* Maximum pop-up commands -pt*)
 
   SetCount = 7  ;        (* Number of SET commands [pgt001]*)
   SetNot = SetCount+1 ;  (* Non-SET command index *)
   SetAmbig = SetCount+2; (* Ambiguous SET command *)
   ShowCount = SetCount+1;(* SET commands plus 'ALL' *)
   ShowNot = ShowCount+1 ;
   ShowAmbig = ShowCount+2 ;
   MainCount = 9 ;
   MainNot = MainCount+1 ;
   MainAmbig = MainCount+2 ;
 
   (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
   return = #015 ;
   formfeed = #014 ;
   controlbar = 28;
 
   { universal manifest constants }
   ENDSTR = -1;    (* End-of-string value  [pgt001] *)
   MAXSTR = 100;   { longest possible string }
   MsgLength = 20; { length of message string -pt}
 
   { ascii character set in decimal }
   BACKSPACE = 8;
   TAB = 9;
   lf = #012 ; (* Line feed/new line *)
   BLANK = 32;
   EXCLAM = 33;    { ! }
   DQUOTE = 34;    { " }
   SHARP = 35;     { # }
   DOLLAR = 36;    { $ }
   PERCENT = 37;   { % }
   AMPER = 38;     { & }
   SQUOTE = 39;    { ' }
   ACUTE = SQUOTE;
   LPAREN = 40;    { ( }
   RPAREN = 41;    { ) }
   STAR = 42;      { * }
   PLUS = 43;      { + }
   COMMA = 44;     { , }
   MINUS = 45;     { - }
   DASH = MINUS;
   PERIOD = 46;    { . }
   SLASH = 47;     { / }
   COLON = 58;     { : }
   SEMICOL = 59;   { ; }
   LESS = 60;      { < }
   EQUALS = 61;    { = }
   GREATER = 62;   { > }
   QUESTION = 63;  { ? }
   ATSIGN = 64;    { @ }
   LBRACK = 91;    { [ }
   BACKSLASH = 92; { \ }
   ESCAPE = BACKSLASH; {  changed  - used to be @ }
   RBRACK = 93;    { ] }
   CARET = 94;     { ^ }
   UNDERLINE = 95; { _ }
   GRAVE = 96;     { ` }
   LETA = 97;      { lower case ... }
   LETB = 98;
   LETC = 99;
   LETD = 100;
   LETE = 101;
   LETF = 102;
   LETG = 103;
   LETH = 104;
   LETI = 105;
   LETJ = 106;
   LETK = 107;
   LETL = 108;
   LETM = 109;
   LETN = 110;
   LETO = 111;
   LETP = 112;
   LETQ = 113;
   LETR = 114;
   LETS = 115;
   LETT = 116;
   LETU = 117;
   LETV = 118;
   LETW = 119;
   LETX = 120;
   LETY = 121;
   LETZ = 122;
   LBRACE = 123;   { left brace }
   BAR = 124;      { | }
   RBRACE = 125;   { right brace }
   TILDE = 126;    { ~ }
 
 
   SOH        = 1;     (* ascii SOH character *)
   CR         = 13;    (* CR *)
   DEL        = 127;   (* rubout *)
 
   DEFEOL     = CR ;   (* default eoln *)
   DEFTRY     = 10;    (* default for number of retries *)
   DEFTIMEOUT = 12;    (* default time out *)
   MAXPACK    = 94;    (* max is 94 ~ - ' ' *)
   DEFDELAY   = 1;     (* delay before sending first init *)
   NUMPARAM   = 6;     (* number of parameters in init packet *)
   DEFQUOTE   = SHARP; (* default quote character  *)
   DEFPAD     = 0;     (* default number OF padding chars  *)
   DEFPADCHAR = 0;     (* default padding character  *)
 
   NumBuffers = 5;         (* Number of packet buffers *)
 
   (* 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') *)
 
 

TYPE
 
 
   CharBytes = -2..255; (* full 8-bits, with -1 == end-of-string [pgt001]*)
   istring = ARRAY [1..MAXSTR] OF CharBytes;
   MsgString = String[ MsgLength ]; (* String for various messages -pt*)
 
 
   (* Data Types for Kermit *)
 
 
   Packet = RECORD
               mark : CharBytes;       (* SOH character *)
               count: CharBytes;       (* # of bytes following this field *)
               seq  : CharBytes;       (* sequence number modulo 64  *)
               ptype: CharBytes;       (* d,y,n,s,b,f,z,e,t  packet type *)
               data : istring;          (* the actual data *)
               (* chksum is last validchar in data array *)
               (* eol is added, not considered part of packet proper *)
            END;
 
   KermitCommand = (Transmit,Receive,SetParm,Invalid);
 
   KermitStates = (FileData,Init,Break,FileHeader,EOFile,Complete,Abort);
 
   Stats = Real ; (* Statistic counting -pt*)
 
   Ppack = 1..NumBuffers;
 
   CType = RECORD
              check: Integer;
              PacketPtr : Integer;
              i : Integer;
              fld : Integer;
              t : CharBytes;
              finished : Boolean;
              restart : Boolean;
              control : Boolean;
              good : Boolean;
           END;
 
   InType = (abortnow,nothing,CRin);
 
   (* Data types for pop-up menus *)
   MyCmds = ARRAY [1..MaxPopCmds] OF String[25] ;  (* Menu strings *)
   MyMenu = RECORD
               Head: String[25] ;(* Heading *)
               numcmds: Integer ;(* Number of commands *)
               cmd: MyCmds       (* The actual commands *)
            END ;
   MyMenuPtr = ^MyMenu ;
 

VAR
 
 
   done:Boolean;
   bufferoverflow, finis, XOFFState:Boolean;
   ch:Char;
   XON, XOFF:Char;
 
   (* Variables for commands *)
   CmdSpelling, CmdLine: CString ;  (* the command and rest of line *)
   CmdIndex: Integer ;  (* Index from command parser *)
   Inf: pCmdList ;      (* Command file pointer *)
   firstPress: Boolean ;(* Inital call to command parser *)
 
   (* Variables for pop-up menus *)
   MainMenu,            (* Main Kermit menu *)
   SetMenu: MyMenuPtr ; (* SET commands *)
   OnOff: CmdArray ;    (* For the SET feature ON/OFF *)
 
 
 
   (* SET variables *)
   EscapeChr: Char ;    (* CONNECT 'escape' character -pt*)
   EscPrint : Char ;    (* Printable verion of this character -pt*)
   BaudRate : String ;
   FileWarning: Boolean ;
   HalfDuplex:Boolean;
   Verbosity: Boolean;  (* true to print verbose messages *)
   Debug    : Boolean;
   EightBitFile: Boolean ; (* 8-bit flag  [pgt001]*) 
   (* Varibles for Kermit *)
   dumStr   : String ;(* Dummy string -pt*)
   dumCh: Char ;      (* A dummy character -pt*)
 
   aline    : istring;
   DiskFile : Integer;(* Should be "filedesc" -pt*)
   SaveState: kermitstates;
   MaxTry   : Integer;
   n,J      : Integer;  (* packet number *)
   NumTry   : Integer;  (* times this packet retried *)
   OldTry   : Integer;
   NumPad   : Integer;  (* padding to send *)
   MyPad    : Integer;  (* number of padding characters I need *)
   PadChar  : CharBytes;
   MyPadChar: CharBytes;
   RunType  : KermitCommand;
   State    : kermitstates; (* current state of the automaton *)
   MyTimeOut:  Integer;     (* when i want to be timed out *)
   TheirTimeOut  : Integer;
   Delay    : Integer;
   SizeRecv, SizeSend : Integer;
   SendEOL, SendQuote : CharBytes;
   myEOL,myQuote: CharBytes;
   NumSendPacks : Integer;
   NumRecvPacks : Integer;
   NumACK : Integer;
   NumNAK : Integer;
   NumACKrecv : Integer;
   NumNAKrecv : Integer;
   NumBADrecv : Integer;
   RunTime: Integer;
   ChInFile, ChInPack : Stats;
 
   Buf : ARRAY [1..NumBuffers] OF packet;
   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 *)
 
   TOPacket : packet;   (* Time_Out Packet *)
   OldTime  : Double ;  (* Clock time -pt*)
   TimeLeft : Integer;  (* until Time_Out *)
 
   FromConsole : InType;(* Input from Console during receive *)
 
   PackControl : CType; (* variables for receive packet routine *)
 

 
 
   PROCEDURE SYSinit;   (* special initialization *)

   PROCEDURE SYSfinish; (* System dependent *)

   PROCEDURE KermitInit;(* initialize various parameters  & defaults *)


   PROCEDURE ErrorPack(c:MsgString);
   (* Send the other host the an error packet with mesage <c> -pt*)

 
   EXCEPTION GotErrorPacket(VAR ErrorMsg: istring) ;
   (*)
    * This is used when procedure "BuildPacket" receives an error packet
    * from the other Host. Handlers in procedures "RecvSwitch" and
    * "SendSwitch" are used to abort the current RECEIVE/SEND command
    * and close any disk files open.
   (*)
 


PRIVATE

IMPORTS Screen      FROM Screen ;
IMPORTS PopCmdParse FROM PopCmdParse ;
IMPORTS IO_Others   FROM IO_Others ;
IMPORTS RS232Baud   FROM RS232Baud ;
IMPORTS Stdio       FROM Stdio ;
IMPORTS KermitUtils FROM KermitUtils ;
IMPORTS KermitSend  FROM KermitSend ;


PROCEDURE SYSinit; (* special initialization *)
   BEGIN
      Writeln( FF ) ;  (* Clear the entire screen *)
      
      (*----------     PERQ     ----------*)
 
      (* Create the windows *)
      CreateWindow(KermitWindow, 0, 0, 767, 700,
                   'PERQ Kermit, Version 2.0') ;
      (* A cursor for the Kermit window *)
      SCurChr( Chr(#177) ) ;  (* A black rectangle *)
      SCurOn ;   (* Turn it on *)

      CreateWindow(ErrorWindow, 0, 701, 767, 322, 'Error and Message Window') ;

      ChangeWindow( KermitWindow ) ;

      (* Create pop-up menus *)
      New(MainMenu) ;
      WITH  MainMenu^  DO
         BEGIN
            Head := 'Kermit' ;
            numcmds := MainCount ;
            cmd[1] := 'CONNECT' ;
            cmd[2] := 'EXIT' ;
            cmd[3] := 'HELP' ;
            cmd[4] := 'QUIT' ;
            cmd[5] := 'RECEIVE' ;
            cmd[6] := 'SEND' ;
            cmd[7] := 'SET' ;
            cmd[8] := 'SHOW' ;
            cmd[9] := 'STATISTICS' ;
         END ; (* with main menu *)
 
      (* ON or OFF *)
      OnOff[1] := 'ON' ;
      OnOff[2] := 'OFF' ;
 
      New(SetMenu) ;
      WITH  SetMenu^  DO
         BEGIN
            Head := 'SET commands' ;
            numcmds := SetCount ;  (* 7 if we include "ALL" for SHOW cmd *)
            cmd[1] := 'SPEED' ;
            cmd[2] := 'DEBUG' ;
            cmd[3] := 'ESCAPE' ;
            cmd[4] := 'WARNING' ;
            cmd[5] := 'LOCAL' ;
            cmd[6] := 'VERBOSE' ;
            cmd[7] := 'EIGHT-BIT' ; (* [pgt001] *)
            cmd[8] := 'ALL' ;   (* <<<< *)
         END ; (* with SET menu *)
 
      (* other initialisation *)
      InitCmdFile(Inf, 0) ;
      InitPopUp ;
      IOCursorMode( TrackCursor ) ;
      firstPress := True ;
 
      (*----------     KERMIT     ----------*)
      finis:=False;
      XOFFState:=False;
      XON:=Chr(#021); XOFF:=Chr(#023);
 
      (* SET values  -pt*)
      EscapeChr := Chr(#034) ;  (* CONNECT escape character ^\ *)
      EscPrint  := '\' ;        (* Printable version *)
      BaudRate := '9600' ;
      SetBaud( '9600', True ) ;
      HalfDuplex:=False ;
      Verbosity := False;       (* default to false / only valid if local *)
      Debug := False;
      EightBitFile := False ;   (* [pgt001] *)
      FileWarning := False ;
 
 
      (* Statistic counters *)
      NumSendPacks := 0;
      NumRecvPacks := 0;
      NumACK := 0;
      NumNAK := 0;
      NumACKrecv := 0;
      NumNAKrecv := 0;
      NumBADrecv := 0;
 
      ChInFile := 0.0;  (* Statsistics are now reals.  -pt*)
      ChInPack := ChInFile;

      (* Other values *)
      NumPad := DEFPAD;               (* set defaults *)
      MyPad := DEFPAD;
      PadChar := DEFPADCHAR;
      MyPadChar := DEFPADCHAR;
      TheirTimeOut := DEFTIMEOUT;
      MyTimeOut := DEFTIMEOUT;
      Delay := DEFDELAY;
      SizeRecv := MAXPACK;
      SizeSend := MAXPACK;
      SendEOL := DEFEOL;
      MyEOL := DEFEOL;
      SendQuote := DEFQUOTE;
      MyQuote := DEFQUOTE;
      MaxTry := DEFTRY;
 
   END;
 
PROCEDURE SYSfinish; (* System dependent *)
   BEGIN
      Writeln( FF ) ;
      Dispose( MainMenu ) ;
      Dispose( SetMenu ) ;
      DstryCmdFile( Inf ) ;
   END;
 
 
PROCEDURE KermitInit;  (* initialize various parameters  & defaults *)
   BEGIN
      n := 0;
 
      RunType := invalid;
      DiskFile := StdIOError;      (* to indicate not open yet *)
 
      ThisPacket := 1;
      LastPacket := 2;
      CurrentPacket := 3;
      NextPacket := 4;
      InputPacket := 5;
 
      WITH TOPacket DO
         BEGIN
            count := 3;
            seq := 0;
            ptype := TYPEN;
            data[1] := ENDSTR;
         END;
 
      FROMCONSOLE:=NOTHING;
 
   END;
 

 
 
PROCEDURE CtoS(x:MsgString; VAR s:istring);
   (* convert constant to STIP string *)
   VAR
      i : Integer;
   BEGIN
      FOR i:=1 TO Length(x) DO
         s[i] := Ord(x[i]);
      s[Length(x)+1] := ENDSTR;
   END;
 
PROCEDURE ErrorPack(c:MsgString);
   (* output Error packet if necessary -- then exit *)
   BEGIN
      WITH Buf[ThisPacket] DO
         BEGIN
            seq := n;
            ptype := TYPEE;
            CtoS(c,data);
            count := ilength(data);
         END;
      SendPacket;
      Writeln('%Message to other Host: ', c)
   END.

(* <<<KermitHelp.Pas>>> *)
MODULE KermitHelp ;

EXPORTS

PROCEDURE DoHelp ;

PRIVATE

IMPORTS  KermitUtils FROM KermitUtils ;


PROCEDURE DoHelp ;
(*)
 * Print out the Kermit help info. Use the utilities to write the
 * commands in inverse video.
(*)
BEGIN (*-DoHelp-*)
Writeln( Chr(#014) ) ; (* Clear the screen *)
Inverse( TRUE ) ;  Writeln(' CONNECT'); Inverse( FALSE ) ;
Writeln('Connect the PERQ to another host.  This allows you to log  into  other');
Writeln('systems.');
Inverse( TRUE ) ;  Writeln(' EXIT'); Inverse( FALSE ) ;
Writeln('Exit from KERMIT back to the PERQ operating system.');
Inverse( TRUE ) ;  Writeln(' HELP'); Inverse( FALSE ) ;
Writeln('Print instructions on various commands available in KERMIT.');
Inverse( TRUE ) ;  Writeln(' QUIT'); Inverse( FALSE ) ;
Writeln('Same as EXIT.');
Inverse( TRUE ) ;  Writeln(' RECEIVE <optional file-name>'); Inverse( FALSE ) ;
Writeln('Receive a file group from the remote host.  If an incoming  file  name');
Writeln('is  not  legal,  then attempt to transform it to a similar legal name,');
Writeln('e.g.  by deleting  illegal  or  excessive  characters.   If  the  file');
Writeln('already exists, it will be superceded unless WARNING is ON.');
Inverse( TRUE ) ;  Writeln(' SEND <file-specification>'); Inverse( FALSE ) ;
Writeln('Sends a file from the PERQ to the remote host.  The name of  the  file');
Writeln('is  passed to the remote host in a special control packet, so that the');
Writeln('remote host can store it with the same name.  Wildcards  are  not  yet');
Writeln('supported.');
Inverse( TRUE ) ;  Writeln(' SET <keyword>'); Inverse( FALSE ) ;
Writeln('Change various system-dependent parameters.  For a list  of  keywords,');
Writeln('type SET ?.');
Inverse( TRUE ) ;  Writeln(' SHOW <keyword>'); Inverse( FALSE ) ;
Writeln('Display various system-dependent parameters  established  by  the  SET');
Writeln('command.  For a list of available keywords type SHOW ?.');
Inverse( TRUE ) ;  Writeln(' STATISTICS'); Inverse( FALSE ) ;
Writeln('Display some statistics about Kermit''s operations.');

Writeln
END (*-DoHelp-*) .

(* <<<KermitParms.Pas>>> *)
MODULE KermitParms ;
 
(* Deal with various Kermit Parameters: Set and Show *)
(* 29-Nov-83 Allow eight bit file transfer [pgt001] *)
 
 
EXPORTS
 
 
PROCEDURE SetParameters ;
PROCEDURE DoShow ;
 
 
 

PRIVATE
 
IMPORTS KermitGlobals   FROM KermitGlobals ;
IMPORTS RS232Baud       FROM RS232Baud ;
IMPORTS CmdParse        FROM CmdParse ;
IMPORTS PopCmdParse     FROM PopCmdParse ;
IMPORTS PopUp           FROM PopUp ;
IMPORTS Perq_String     FROM Perq_String ;
 
 
PROCEDURE SetParameters ;
   (* Set Kermit flags and other communications features -pt*)
   VAR
      id, parm: String ; (* SET identifier and (possible) parameter *)
      switch, parmsw: Boolean ; (* Switch flags for feature and parameter *)
      index: Integer ; (* Command index *)
 
   PROCEDURE DoBaudRate( NewRate: String ) ;
      (* Try to set a new baud rate for the RS232 port *)
      CONST
         InputEnable = True ; (* Enable RS232 input *)
 
      HANDLER BadBaudRate ;
         BEGIN (*-BadBaudRate-*)
            Writeln('?Bad baud rate given: ', NewRate) ;
            EXIT( DoBaudRate )
         END ; (*-BadBaudRate-*)
 
      BEGIN (*-DoBaudRate-*)
         IF (NewRate = '') THEN Writeln('%No value for SET SPEED')
         ELSE
            BEGIN
               (* set the rate *)
               SetBaud( NewRate, InputEnabled) ;
               (* Here if that was successful, save the new rate *)
               BaudRate := NewRate
            END
      END ; (*-DoBaudRate-*)
 
   FUNCTION MkOctal( src: String ): Integer ;
      (* convert the octal number in the source string into a number *)
      VAR
         i, sum: Integer ; (* index and summation value *)
         ok: Boolean ;     (* loop control *)
      BEGIN (*-MkOctal-*)
         ok := True ;  i := 1 ;  sum := 0 ;
         WHILE ok DO
            IF NOT (src[i] IN ['0'..'7']) THEN ok := False (* reached non-octal *)
            ELSE
               BEGIN
                  sum := sum*8 + Ord(src[i]) - #60 ;
                  i := i + 1 ;
                  ok := (i <= Length(src)) (* exit test *)
               END ;
         MkOctal := sum
      END ; (*-MkOctal-*)
 
   PROCEDURE DoEscChr( OctalStr: String ) ;
      (* try to set a new CONNECT escape character *)
      (* OctalStr contains the string representation of the octal number *)
      VAR
         val: Integer ; (* The escape character's ordinal *)
      BEGIN (*-DoEscChr-*)
         IF (OctalStr = '') THEN
            Writeln('?SET ESCAPE requires an octal number')
         ELSE
            IF (OctalStr[1] IN ['0'..'7']) THEN
               BEGIN
                  val := MkOctal( OctalStr ) ; (* Get the value *)
                  IF (val = 0) OR (val > #037) THEN
                     Writeln('%Illegal ESCAPE character value: ', val:1:8)
                  ELSE
                     BEGIN
                        (* set the character and its printable version *)
                        EscapeChr := Chr( val ) ;
                        EscPrint  := Chr( val + #100 )
                     END
               END (* octal digit *)
            ELSE
               Writeln('?Non-Octal digit in SET ESCAPE parameter')
      END ; (*DoEscChr-*)
 
   PROCEDURE DoOnOff(VAR flag: Boolean) ;
      (*)
       * For the set feature with menu index <index> see if <parm> is
       * either ON or OFF. If so, set <flag> to True or False, resp.
       * Otherwise write error message and leave <flag> alone.
      (*)
      VAR
         val: Integer ; (* Value of table search ON/OFF *)
      BEGIN (*-DoOnOff-*)
         
         ConvUpper( parm ) ;  (* MUST be upper case *)
         
         IF (parm = '') THEN val := 3  (* not ON/OFF *)
         ELSE
            val := UniqueCmdIndex(parm, OnOff, 2) ;
 
         CASE  val  OF
            1: flag := True ;   (* ON  *)
            2: flag := False ;  (* OFF *)
            3: Writeln('%SET ', SetMenu^.Cmd[index], ' requires ON or OFF') ;
            4: Writeln('%Ambiguous ON or OFF in SET ', SetMenu^.Cmd[index] )
         END ; (* case *)
 
      END ; (*-DoOnOff-*)
 
   PROCEDURE SetHelp ;
      (* Provide help information for the command SET ?     *)
      BEGIN (*-SetHelp-*)
         Writeln ;
         Writeln('The following features are available with the SET command :') ;
         Writeln ;
         Writeln('SPEED <rate>       Change the PERQ''s line speed') ;
         Writeln('DEBUG ON|OFF       Print debug information') ;
         Writeln('ESCAPE <octal>     Change the CONNECT escape character') ;
         Writeln('WARNING ON|OFF     Give warning when overwriting existing files') ;
         Writeln('LOCAL ON|OFF       Echo CONNECT typein locally') ;
         Writeln('VERBOSE ON|OFF     Display Kermit''s actions') ;
         Writeln('EIGHT-BIT ON|OFF   Allow eight bit file transfer');(*[pgt001]*)
         Writeln
      END ; (*-SetHelp-*)
 
   BEGIN (*-SetParameter-*)
      (* If the command line is empty, prompt user *)
      IF (CmdLine = '') THEN
         BEGIN
            Write('Kermit-SET', PromptChar) ;
            Readln( CmdLine )
         END ;
 
      (* get the first identifier from the line *)
      dumCh := NextIDString( CmdLine, id, switch ) ;
      (* and a possible parameter *)
      dumCh := NextIDString( CmdLine, parm, parmsw ) ;
 
      IF (id = '') THEN (* nothing - return *)
      ELSE
         IF switch OR parmsw THEN Writeln('%SET does not take switches')
         ELSE
            IF (id[1] = '?') THEN SetHelp
            ELSE
               BEGIN
 
                  index := PopUniqueCmdIndex(id, RECAST(SetMenu, pNameDesc) ) ;
                  (* What was the command ? *)
                  CASE  index  OF
                     1: DoBaudRate( parm ) ;         (* SPEED *)
                     2: DoOnOff( debug ) ;           (* DEBUG *)
                     3: DoEscChr( parm ) ;           (* ESCAPE *)
                     4: DoOnOff( FileWarning ) ;     (* WARNING *)
                     5: DoOnOff( HalfDuplex ) ;      (* LOCAL *)
                     6: DoOnOff( Verbosity ) ;       (* VERBOSE *)
                     7: DoOnOff( EightBitFile ) ;    (* EIGHT-BIT [pgt001]*)
                     8: Writeln('%Not a SET feature: ', id) ;
                     9: Writeln('%Ambiguous SET feature: ', id)
                  END ; (* case *)
               END (* else *)
 
   END ; (*-SetParameter-*)
 
 
 
PROCEDURE DoShow ;
   (* Show the Kermit flags and parameters *)
   VAR
      flag: ARRAY [Boolean] OF String[3] ;  (* OF or OFF *)
      id: String ;   (* identifier *)
      switch: Boolean ;  (* SHOW /xxx    flag *)
      i: Integer ;   (* Index *)
 
   PROCEDURE Feature( index: Integer ) ;
      (* write a single feature - Index into SetMenu *)
      BEGIN (*-Index-*)
         CASE  index  OF
            1: Writeln('Baud rate  ', BaudRate) ;
            2: Writeln('Debug      ', flag[debug]) ;
            3: Writeln('Escape chr ^', EscPrint,'     (Octal ', Ord(EscapeChr):1:8, ')') ;
            4: Writeln('Warning    ', flag[FileWarning]) ;
            5: Writeln('Local      ', flag[HalfDuplex]) ;
            6: Writeln('Verbose    ', flag[Verbosity]) ;
            7: Writeln('Eight-Bit  ', flag[EightBitFile])  (*[pgt001]*)
            END  (* case *)
      END ; (*-Feature-*)
 
   BEGIN (*-DoShow-*)
 
      Writeln ;
      flag[True] := 'ON' ;
      flag[False]:= 'OFF' ;
 
      (* get the show feature *)
      dumCh := NextIDString(CmdLine, id, switch) ;
      IF (id = '') THEN id := 'ALL' ; (* Default *)
 
      IF switch THEN
         Writeln('%SHOW does not take switches')
      ELSE
      IF (id[1] = '?') THEN (* simple help *)
         BEGIN
            Writeln('One of the following :-') ;
            WITH  SetMenu^  DO
               FOR i := 1 TO ShowCount DO (* include 'ALL' *)
                  Writeln( Cmd[i] )
         END
      ELSE (* find feature's index *)
         BEGIN
            (* add 'ALL' to the search *)
            SetMenu^.numcmds := ShowCount ;
            i := PopUniqueCmdIndex( id, RECAST(SetMenu, pNameDesc) ) ;
            SetMenu^.numcmds := SetCount ;
 
            IF (i <= SetCount) THEN Feature( i )
            ELSE
               IF (i = ShowCount) THEN
                  BEGIN
                     FOR i := 1 TO SetCount DO Feature(i)
                  END
               ELSE
                  IF (i = ShowNot) THEN
                     Writeln('?Not a SHOW parameter: ', id)
                  ELSE
                     IF (i = ShowAmbig) THEN
                        Writeln('%Ambiguous SHOW parameter: ', id)
         END ; (* else *)
      Writeln
   END . (*-DoShow-*)

(* <<<KermitRecv.Pas>>> *)
MODULE KermitRecv ;
 
(* 29-Nov-83  Allow eight bit file transfer (c.f. sopen call) [pgt001] *)
(* 30-Nov-83  During a receive clear the screen and show characters    *)
(*            and packets received.      [pgt002]                      *)


EXPORTS
 
FUNCTION ReceiveACK : (* Returning *) Boolean;
PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)
 

PRIVATE
 
IMPORTS KermitGlobals   FROM KermitGlobals ;
IMPORTS KermitUtils     FROM KermitUtils ;
IMPORTS Stdio           FROM Stdio ;
IMPORTS KermitError     FROM KermitError ;
IMPORTS KermitSend      FROM KermitSend ;  (* for sending ACKs and NAKs, etc *)
IMPORTS Screen          FROM Screen ;  (* screen control [pgt002] *)


VAR
   OldChInFile: Stats ;  (* Characters in file [pgt002]*)
   BadPackets: Integer ; (* Bad packet count for this recv [pgt002]*)


{$RANGE-}     (* Range checks off to see if it runs faster   (16-Jan-84)*)


PROCEDURE Field1; (* Count *)
   VAR
      test: Boolean;
   BEGIN
      WITH Buf[NextPacket] DO
         BEGIN
            WITH PackControl DO
               BEGIN
                  Buf[InputPacket].count := t;
                  count := UnChar(t);
                  test := (count >= 3) OR (count <= SizeRecv-2);
                  (* IF (NOT test) AND Debug THEN ErrorMsg('Bad count'); *)
                  good := good AND test;
               END;
         END;
   END;
 
PROCEDURE Field2; (* Packet Number *)
   VAR
      test : Boolean;
   BEGIN
      WITH Buf[NextPacket] DO
         BEGIN
            WITH PackControl DO
               BEGIN
                  Buf[InputPacket].seq := t;
                  seq := UnChar(t);
                  test := (seq >= 0) OR (seq <= 63);
                  (* IF (NOT test) AND Debug THEN ErrorMsg('Bad seq number'); *)
                  good := test AND good;
               END;
         END;
   END;
 
PROCEDURE Field3; (* Packet Type *)
   VAR
      test : Boolean;
   BEGIN
      WITH Buf[NextPacket] DO
         BEGIN
            WITH PackControl DO
               BEGIN
                  ptype := t;
                  Buf[InputPacket].ptype := t;
                  test := IsValidPType(ptype);
                  (* IF (NOT test) AND Debug THEN ErrorMsg('Bad Packet Type'); *)
                  good := test AND good;
               END;
         END;
   END;
 
PROCEDURE Field4; (* Data *)
   BEGIN
      WITH PackControl DO
         BEGIN
            PacketPtr := PacketPtr+1;
            Buf[InputPacket].data[PacketPtr] := t;
            WITH Buf[NextPacket] DO
               BEGIN
                  IF (t = MyQuote) THEN    (* character is quote *)
                     BEGIN
                        IF control THEN        (* quote ,quote  *)
                           BEGIN
                              data[i] := MyQuote;
                              i := i+1;
                              control := False;
                           END
                        ELSE      (* set control on *)
                           control := True
                     END
                  ELSE                 (* not quote *)
                     IF control THEN      (* convert to control *)
                        BEGIN
                           data[i] := ctl(t);
                           i := i+1;
                           control := False
                        END
                     ELSE      (* regular data *)
                        BEGIN
                           data[i] := t;
                           i := i+1;
                        END;
               END;
         END;
   END;
 
PROCEDURE Field5; (* Check Sum *)
   VAR
      test : Boolean;
   BEGIN
      WITH PackControl DO
         BEGIN
            PacketPtr := PacketPtr +1;
            Buf[InputPacket].data[PacketPtr] := t;
            Buf[InputPacket].data[PacketPtr + 1] := ENDSTR;
            check := CheckFunction(check);
            check := MakeChar(check);
            test := (t=check);
            IF (NOT test) AND Debug THEN ErrorMsg('Bad CheckSum');
            good := test AND good;
            Buf[NextPacket].data[i] := ENDSTR;
            finished := True;  (* set finished *)
         END;
   END;
 
PROCEDURE BuildPacket;
   (* receive packet & validate checksum *)
   VAR
      temp : Ppack;
   BEGIN
      WITH PackControl DO
         BEGIN
            WITH Buf[NextPacket] DO
               BEGIN
                  IF (t <> ENDSTR) THEN
                     IF restart THEN
                        BEGIN
                           (* read until get SOH marker *)
                           IF (t = SOH) THEN
                              BEGIN
                                 finished := False;    (* set varibles *)
                                 control := False;
                                 good := True;
                                 seq := -1;        (* set return values to bad packet *)
                                 ptype := QUESTION;
                                 data[1] := ENDSTR;
                                 data[MAXSTR] := ENDSTR;
                                 restart := False;
                                 fld := 0;
                                 i := 1;
                                 PacketPtr := 0;
                                 check := 0;
                              END;
                        END
                     ELSE  (* Not restart -pt*)    (* have started packet *)
                        BEGIN
                           IF (t = SOH) THEN    (* check for restart or EOL *)
                              restart := True
                           ELSE
                              IF (t = myEOL) THEN
                                 BEGIN
                                    finished := True;
                                    good := False;
                                 END
                              ELSE
                                 BEGIN
                                    CASE fld OF
                                       (* increment field number *)
                                       0:   fld := 1;
                                       1:   fld := 2;
                                       2:   fld := 3;
                                       3:
                                          IF (count = 3)  (* no data *)
                                          THEN fld := 5
                                          ELSE fld := 4;
                                       4:
                                          IF (PacketPtr>=count-3) (* end of data *)
                                          THEN fld := 5;
                                       END (* case *);
                                    IF (fld <> 5)
                                    THEN  check := check+t; (* add into checksum *)
 
                                    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 good THEN (* error_packets *)
                           BEGIN
                              SendACK(n);          (* send ACK *)

                              RAISE GotErrorPacket( data ) ; (* ********** *)

                           END;
                        NumRecvPacks := NumRecvPacks+1;
                        IF Debug THEN
                           BEGIN
                              DebugPacket('Received: ',InputPacket);
                              IF good THEN ErrorMsg('Is Good');
                           END;
 
                        temp := CurrentPacket;
                        CurrentPacket := NextPacket;
                        NextPacket := temp;
                     END;
               END;
         END;
   END;
 
FUNCTION ReceivePacket: Boolean;
   BEGIN
      WITH PackControl DO
         BEGIN
            StartTimer;
            good := False ;
            finished := False;
            restart := True;
            (* No Keyboard Interupt - Set by ^C handler -pt*)
            FromConsole := nothing;
            REPEAT
               t := GetIn;

               CheckTimer ;
               IF (FromConsole = abortnow) THEN
                  BEGIN
                     State := ABORT ;
                     ReceivePacket := False ;
                     EXIT( ReceivePacket )
                  END;

               BuildPacket;
            UNTIL finished  OR (TimeLeft <= 0);
            IF (TimeLeft <= 0) THEN
               BEGIN
                  Buf[CurrentPacket] := TOPacket;
                  restart := True;
                  IF NOT ((RunType=Transmit) AND (State=Init)) THEN
                     BEGIN
                        ErrorInt('%Timed out ', n)
                     END;
               END;
            StopTimer;
            IF NOT good THEN BadPackets := BadPackets + 1 ;
            ReceivePacket := good;
         END;
   END;
 
FUNCTION ReceiveACK : (* Returning *) Boolean;
   (* receive ACK with correct number *)
   VAR
      Ok: Boolean;
   BEGIN
      Ok := ReceivePacket;
      WITH Buf[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 GetFile((* Using *) data:istring);
   (* create file from fileheader packet *)
   VAR
      len: Integer;
   
   PROCEDURE Strip( var name: istring ) ;
   (* Strip off any blanks (usually trailing) from the file name *)
   VAR i, newpos: integer ;
   BEGIN (*-Strip-*)
      newpos := 1 ;  (* this is the new character position for non-blanks *)
      FOR i := 1 TO ilength(name) DO
        IF (name[i] = blank) THEN (* skip it by not incrementing "newpos"  *)
        ELSE
           BEGIN (* restore character *)
              name[newpos] := name[i] ;
              newpos := newpos + 1
           END ;

      name[newpos] := ENDSTR
   END ; (*-Strip-*)
   
   BEGIN
      WITH Buf[CurrentPacket] DO
         BEGIN
            IF (DiskFile = StdIOError) THEN (* check if we already have a file *)
               BEGIN
                  Strip( data ) ;  (* remove any blanks *)
                  IF Verbosity THEN
                     BEGIN
                        ErrorMsg ('Creating file: ');
                        ErrorStr(data);
                     END;
                  IF Exists(data) AND FileWarning THEN
                     BEGIN
                        ErrorMsg('File already exists ');
                        ErrorStr(data);
                        ErrorMsg('Creating: ');
                        (* Make it <file>.A *)
                        len := ilength(data) + 1 ; (* first free char pos *)
                        data[len] := PERIOD ;
                        data[len+1] := leta ;
                        data[len+2] := ENDSTR;
                        ErrorStr(data)
                     END;
                  IF EightBitFile THEN
                     DiskFile := Sopen(data,StdIO8Write)
                  ELSE
                     DiskFile := Sopen(data,StdIOWrite);
               END;
            IF (Diskfile <= StdIOError) THEN ErrorPack('Cannot create file  ');
         END;
   END;
 
PROCEDURE ReceiveInit;
   (* receive init packet *)
   (* respond with ACK and  our parameters *)
   BEGIN
      IF (NumTry > MaxTry) THEN
         BEGIN
            State := Abort;
            ErrorMsg('Cannot receive init');
         END
      ELSE
         BEGIN
            Verbose('Receiving Init');
            NumTry := NumTry+1;
            IF ReceivePacket
               AND (Buf[CurrentPacket].ptype = TYPES) THEN
               BEGIN
                  WITH Buf[CurrentPacket] DO
                     BEGIN
                        n := seq;
                        DeCodeParm(data);
                     END;
 
                  (* now send mine *)
                  WITH Buf[ThisPacket] DO
                     BEGIN
                        count := NUMPARAM;
                        seq := n;
                        Ptype := TYPEY;
                        EnCodeParm(data);
                     END;
 
                  SendPacket;
 
                  NumACK := NumACK+1;
                  State := FileHeader;
                  OldTry := NumTry;
                  NumTry := 0;
                  n := (n+1) MOD 64
               END
            ELSE
               BEGIN
                  IF Debug THEN ErrorMsg('Received Bad init');
                  SendNAK(n);
               END;
         END;
   END;
 
PROCEDURE DataToFile; (* output to file *)
   VAR
      len,i : Integer;
      temp : istring;
   BEGIN
      WITH Buf[CurrentPacket] DO
         BEGIN
            len := ilength(data);
            ChInFile := ChInFile + len ;
            PutStr(data,DiskFile)
         END;
   END;
 
PROCEDURE Dodata;  (* Process Data packet *)
 
   BEGIN
      WITH Buf[CurrentPacket] DO
         BEGIN
            IF ( seq = ((n + 63) MOD 64)) THEN
               BEGIN                (* data last one *)
                  IF (OldTry > MaxTry) THEN     (* number of tries? *)
                     BEGIN
                        State := Abort;
                        ErrorMsg('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
                        SendACK(n); (* ACK *)
                        DataToFile;
                        OldTry := NumTry;
                        NumTry := 0;
                        n := (n+1) MOD 64;
                     END;
               END;
         END;
   END;
 
PROCEDURE DoFileLast;   (* Process File Packet *)
   BEGIN          (* File header - last one  *)
      IF (OldTry > MaxTry) THEN   (* tries ? *)
         BEGIN
            State := Abort;
            ErrorMsg('Old file - Too many ');
         END
      ELSE
         BEGIN
            OldTry := OldTry+1;
            WITH Buf[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 *)
      IF (Buf[CurrentPacket].seq <> n) THEN   (* packet number ? *)
         SendNAK(n) (* NAK *)
      ELSE
         BEGIN               (* send ACK *)
            SendACK(n);
            Sclose(DiskFile);  (* close file *)
            DiskFile := StdIOError;
            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;
      packetnum: istring;
      good : Boolean;
 
   BEGIN
      IF (NumTry > MaxTry) THEN    (* check number of tries *)
         BEGIN
            State := Abort;
            ErrorInt('Recv data -Too many ', n)
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;                (* increase number of tries *)
            good := ReceivePacket;        (* get packet *)
            WITH Buf[CurrentPacket] DO
               BEGIN
                  IF Verbosity THEN
                     BEGIN
                        ErrorInt('Receiving (Data) ', Buf[CurrentPacket].seq);
                     END ;

                  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
                        Verbose('Expected data pack');
                        SendNAK(n);
                     END;
               END;
         END;
   END;
 
PROCEDURE DoBreak; (* Process Break packet *)
   BEGIN                    (* Break transmission *)
      IF (Buf[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 *)
      WITH Buf[CurrentPacket] DO
         BEGIN
            IF (seq <> n) THEN         (* packet number ? *)
               SendNAK(n)  (* NAK *)
            ELSE
               BEGIN               (* send ACK *)
                  SendACK(n);
                  ChInFile := ChInFile + ilength(data) ;
                  GetFile(data);   (* get file name *)
                  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*)
      IF (OldTry > MaxTry) THEN (* tries ? *)
         BEGIN
            State := Abort;
            ErrorMsg('Old EOF - Too many');
         END
      ELSE
         BEGIN
            OldTry := OldTry+1;
            WITH Buf[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 *)
      IF (OldTry > MaxTry) THEN  (* number of tries? *)
         BEGIN
            State := Abort;
            ErrorMsg('Old init - Too many');
         END
      ELSE
         BEGIN
            OldTry := OldTry+1;
            (* packet number *)
            IF (Buf[CurrentPacket].seq = ((n + 63) MOD  64)) THEN
               BEGIN   (* send ACK *)
                  WITH Buf[ThisPacket] DO
                     BEGIN
                        count := NUMPARAM;
                        seq := Buf[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
      IF (NumTry > MaxTry) THEN     (* check number of tries *)
         BEGIN
            State := Abort;
            ErrorMsg('Recv file - Too many');
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;                (* increase number of tries *)
            good := ReceivePacket;             (* get packet *)
            WITH Buf[CurrentPacket] DO
               BEGIN
                  IF Verbosity THEN BEGIN
                     ErrorInt('Receiving (File) ', seq)
                  END;

                  (* Set up for new file [pgt002] *)
                  OldChInFile := ChInFile ; (* Start value *)
                  BadPackets := 0 ;

                  SSetCursor(250, 100) ;
                  Write('File: ');
                  PutStr(data,stdout);
                  Write(' ':10) ; (* blank the end  of any other names *)

                  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   ErrorMsg('Expected File Pack');
                        SendNAK(n);
                     END;
               END;
         END;
   END;

 
PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)

   HANDLER GotErrorPacket( VAR msg: istring ) ;
     (* Handle any error packets reveived. Write msg and exit *)
     BEGIN
        Inverse( TRUE ) ;
        Writeln ;
        Writeln('?RECV received error packet from other Host');
        putstr(msg, STDOUT) ;
        Writeln ;
        Inverse( FALSE ) ;
        SClose( DiskFile ) ;  (* Close the file, if open *)
        State := Abort ;
        EXIT( RecvSwitch )
     END ;

   BEGIN
      State := Init;
      NumTry := 0;

      OldChInFile := ChInFile ; (* Start value *)
      BadPackets := 0 ;

      (* set up the progress reports (c.f. ReceiveFile too) [pgt002] *)
      IF NOT Verbosity THEN
         BEGIN
           SPutChr(FF) ; (* clear the screen *)
           SSetCursor(200, 150);   Write( 'Current Packet' );
           SSetCursor(200, 170);   Write( 'Characters received' );
           SSetCursor(200, 190);   Write( 'Bad packets received' )
         END ;


      REPEAT

         (* Each time thru' the loop print the values [pgt002] *)
         IF NOT Verbosity THEN
            BEGIN
              SSetCursor(410, 150);  Write( n:8 ) ;
              SSetCursor(410, 170);  Write( (ChInFile-OldChInFile):10:0 ) ;
              SSetCursor(410, 190);  Write( BadPackets:8 )
            END ;


         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 );
   
      SSetCursor(10, 250) ;
      Writeln
   END.

(* <<<KermitSend>>> *)
MODULE KermitSend ;

(* 29-Nov-83 Allow eight bit file transfer (c.f. sopen call) [pgt001] *)
 
 
EXPORTS
 
PROCEDURE SendPacket;
PROCEDURE SendACK((* Using *) n:Integer); (* send ACK packet *)
PROCEDURE SendNAK((* Using *) n:Integer); (* send NAK packet *)
PROCEDURE SendSwitch;
 
 
 

PRIVATE
 
IMPORTS KermitGlobals   FROM KermitGlobals ;
IMPORTS KermitUtils     FROM KermitUtils ;
IMPORTS Stdio           FROM Stdio ;
IMPORTS KermitError     FROM KermitError ;
IMPORTS KermitRecv      FROM KermitRecv ;    (* for receiving ACKs and NAKs *)
IMPORTS UtilProgress    FROM UtilProgress ;
IMPORTS Sleep           FROM Sleep ;
 

{$RANGE-}    (* Range checks off   16-Jan-84 *)




VAR
   DataSendCount: Integer ; (* counter for progress *)
 
 
PROCEDURE PutOut( p : Ppack); (* Output Packet *)
   (* Use direct calls to XmtChar to send the characters -pt*)
   VAR
      i : Integer;
   BEGIN
      IF (NumPad > 0) THEN
         FOR i := 1 TO NumPad DO
            XmtChar( Chr(PadChar) );
      WITH Buf[p] DO
         BEGIN
            XmtChar( Chr(mark) );
            XmtChar( Chr(count) );
            XmtChar( Chr(seq) );
            XmtChar( Chr(ptype) );
            FOR i := 1 TO ilength(data) DO
               XmtChar( Chr(data[i]) );
         END;
   END;
 
 
PROCEDURE ReSendPacket;
   (* re -sends previous packet *)
   BEGIN
      NumSendPacks := NumSendPacks+1;
      ChInPack := ChInPack + NumPad + UnChar(Buf[LastPacket].count) + 3 ;
      IF Debug
      THEN DebugPacket('Re-Sending: ',LastPacket);
      PutOut(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
      IF (NumTry <> 1) AND (RunType = Transmit) THEN
         ReSendPacket
      ELSE
         BEGIN
            WITH Buf[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
                        chksum := chksum + data[i];       (* loop for data *)
                  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);
            PutOut(ThisPacket);
 
            IF (RunType = Transmit) THEN
               BEGIN
                  ChInPack := ChInPack + NumPad + len + 6;
                  temp := LastPacket;
                  LastPacket := ThisPacket;
                  ThisPacket := temp;
               END;
         END
 
   END;
 
PROCEDURE SendACK((* Using *) n:Integer); (* send ACK packet *)
   BEGIN
      WITH Buf[ThisPacket] DO
         BEGIN
            count := 0;
            seq := n;
            ptype := TYPEY;
         END;
      SendPacket;
      NumACK := NumACK+1;
   END;
 
PROCEDURE SendNAK((* Using *) n:Integer); (* send NAK packet *)
   BEGIN
      WITH Buf[ThisPacket] DO
         BEGIN
            count := 0;
            seq := n;
            ptype := TYPEN;
         END;
      SendPacket;
      NumNAK := NumNAK+1;
   END;
 
 
 
PROCEDURE GetData((* Returning *)   VAR newstate:KermitStates);
   (* get data from file into ThisPacket *)
   VAR
      (* and return next state - data &  EOF *)
      x,c : CharBytes;
      i: Integer;
   BEGIN
      IF (NumTry = 1) THEN
         BEGIN
            i := 1;
            x := ENDSTR;
            WITH Buf[ThisPacket] DO
               BEGIN
                  WHILE (i< SizeSend - 8 ) AND (x <> ENDFILE)
                  (* leave room for quote  & NEWLINE *)
                  DO
                     BEGIN
                        x := getcf(c,DiskFile);
                        IF (x <> ENDFILE) THEN
                           IF IsControl(x) OR (x = SendQuote) THEN
                              BEGIN           (* control char -- quote *)
                                 IF (x = LF) THEN  (* use proper EOL *)
                                   BEGIN
                                      data[i] := SendQuote;
                                      i := i+1;
                                      data[i] := Ctl(CR);
                                      i := i+1;
                                      (* LF will sent below *)
                                   END;
                                 data[i] := SendQuote;
                                 i := i+1;
                                 IF (x <> SendQuote) THEN  data[i] := Ctl(x)
                                 ELSE  data[i] := SendQuote;
                              END
                           ELSE               (* regular char *)
                              data[i] := x;
 
                        IF (x <> ENDFILE) THEN
                           BEGIN
                              i := i+1;    (* increase count for next char *)
                              ChInFile := ChInFile + 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);
                        DiskFile := StdIOError;
                     END
                  ELSE
                     newstate := FileData;
                  SaveState := newstate;        (* save state *)
               END
         END
      ELSE
         newstate := SaveState;        (* get old state *)
   END;
 
FUNCTION GetNextFile: (* Returning *) Boolean;
   (* get next file to send in ThisPacket *)
   (* returns true if no more *)
   (*         ----    --      -pt*)
   VAR
      result: Boolean;
   BEGIN
      result := True;
      IF (NumTry = 1) THEN
         WITH Buf[ThisPacket] DO
            BEGIN
               IF GetArgument(data) THEN
                  BEGIN            (* open file  *)
                     IF Exists(data) THEN
                        BEGIN
                           (* Initialise counter for each file to be sent *)
                           DataSendCount := 0 ;

                           IF EightBitFile THEN  (* [pgt001] *)
                              DiskFile := Sopen(data,StdIO8Read)
                           ELSE
                              DiskFile := Sopen(data,StdIORead);

                           count := ilength(data);
                           ChInFile := ChInFile + count ;
                           seq := n;
                           ptype := TYPEF;
                           Write('[Sending ');
                           PutStr(data,stdout);
                           Writeln(']') ;
                           IF (DiskFile <= StdIOError) THEN
                              ErrorMsg('?Can''t open file');
                           result := False;
                        END
                     ELSE (* file does not exist *)
                        BEGIN
                           ErrorMsg('?Can''t find file: ') ;
                           ErrorStr( data ) ;
                           result := True  (* I.e. fail: state -> abort *)
                        END
                  END;
            END
      ELSE
         result := False; (* for saved packet *)
      GetNextFile := result;
   END;
 
PROCEDURE SendFile; (* send file name packet *)
   BEGIN
      Verbose( 'Sending ');
      IF (NumTry > MaxTry) THEN
         BEGIN
            ErrorMsg ('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 Verbosity THEN
                     IF (NumTry = 1)
                     THEN ErrorStr(Buf[ThisPacket].data)
                     ELSE ErrorStr(Buf[LastPacket].data);
                  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
      IF (Land(DataSendCount, #03) = 0) THEN
        WITH OpenList[DiskFile] DO
         StreamProgress( FileVar ) ;
      DataSendCount := DataSendCount + 1 ;  (* next "SendData" *)

      IF (NumTry > MaxTry) THEN
         BEGIN
            State := Abort;       (* too many tries, abort *)
            ErrorMsg ('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
      Verbose ('Sending EOF');
      IF (NumTry > MaxTry) THEN
         BEGIN
            State := Abort;       (* too many tries, abort *)
            ErrorMsg('Send EOF - Too Many');
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;
            IF (NumTry = 1) THEN
               BEGIN
                  WITH Buf[ThisPacket] DO
                     BEGIN
                        ptype := TYPEZ;
                        seq := n;
                        count := 0;
                     END
               END;
            SendPacket;
            IF ReceiveACK THEN
               BEGIN
                  State := FileHeader;
                  NumTry := 0;
                  n := (n+1) MOD 64;
               END
         END;
   END;
 
PROCEDURE SendBreak; (* send break packet *)
   BEGIN
      Verbose ('Sending break');
      IF (NumTry > MaxTry) THEN
         BEGIN
            State := Abort;       (* too many tries, abort *)
            ErrorMsg('Send break -Too Many');
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;
            (* make up packet  *)
            IF (NumTry = 1) THEN
               BEGIN
                  WITH Buf[ThisPacket] DO
                     BEGIN
                        ptype := TYPEB;
                        seq := n;
                        count := 0;
                     END
               END;
            SendPacket; (* send this packet *)
            IF ReceiveACK THEN
               BEGIN
                  State := Complete;
               END
         END;
   END;
 
PROCEDURE SendInit;  (* send init packet *)
   BEGIN
      Verbose ('Sending Init');
      IF (NumTry > MaxTry) THEN
         BEGIN
            State := Abort;      (* too many tries, abort *)
            ErrorMsg('Cannot Initialize');
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;
            IF (NumTry = 1) THEN
               BEGIN
                  WITH Buf[ThisPacket] DO
                     BEGIN
                        EnCodeParm(data);
                        count := NUMPARAM;
                        seq := n;
                        ptype := TYPES;
                     END
               END;
 
            SendPacket; (* send this packet *)
            IF ReceiveACK THEN
               BEGIN
                  WITH Buf[CurrentPacket] DO
                     BEGIN
                        SizeSend := UnChar(data[1]);
                        TheirTimeOut := UnChar(data[2]);
                        NumPad := UnChar(data[3]);
                        PadChar := Ctl(data[4]);
                        SendEOL := CR;  (* default to CR *)
                        IF (ilength(data) >= 5) THEN
                           IF (data[5] <> 0) THEN  SendEOL := UnChar(data[5]);
                        SendQuote := SHARP;  (* default # *)
                        IF (ilength(data) >= 6) THEN
                           IF (data[6] <> 0) THEN  SendQuote := data[6];
                     END;
 
                  State := FileHeader;
                  NumTry := 0;
                  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.
    *)
 
   HANDLER GotErrorPacket(VAR msg: istring) ;
      (* We got an error packet when trying to receive another packet. *)
      (* (possibly an ACK). Write the packet data and exit SEND command *)
      BEGIN
         Inverse( TRUE ) ;
         Writeln ;
         Writeln('?SEND received an error packet from the other Host') ;
         putstr(msg, STDOUT) ;
         Writeln ;
         Inverse( FALSE ) ;
         SClose( DiskFile ) ; (* close the disk file if its open *)
         State := Abort ;
         EXIT( SendSwitch )
      END ;


   BEGIN
      LoadCurs ; (* Load the progress cursors *)
      State := Init;              (* send initiate is the start state *)
      NumTry := 0;                (* say no tries yet *)
      IF (Delay > 0) THEN Sleep(Delay);
      REPEAT
         CASE State OF
            FileData:     SendData;         (* data-send state *)
            FileHeader:   SendFile;         (* send file name *)
            EOFile:       SendEOF;          (* send end-of-file *)
            Init:         SendInit;         (* send initialize *)
            Break:        SendBreak;        (* send break *)
            Complete:     (* nothing *);
            Abort:        (* nothing *);
            END (* case *);
      UNTIL ( (State = Abort) OR (State=Complete) );

      QuitProgress ;  (* Remove progress cursors *)

   END.

(* <<<KermitUtils>>> *)
MODULE  KermitUtils;
 
EXPORTS
 
IMPORTS KermitGlobals     FROM KermitGlobals ;


PROCEDURE StartTimer;
PROCEDURE CheckTimer ;
PROCEDURE StopTimer;
PROCEDURE XmtChar(ch:Char);   (* Perq version -pt*)
FUNCTION GetIn :CharBytes;    (* get character *)
FUNCTION UnChar(c:CharBytes): CharBytes;
FUNCTION MakeChar(c:CharBytes): CharBytes;
FUNCTION IsControl(c:CharBytes): Boolean;
FUNCTION IsPrintable(c:CharBytes): Boolean;
FUNCTION Ctl(c:CharBytes): CharBytes;
FUNCTION IsValidPType(c:CharBytes): Boolean;
FUNCTION CheckFunction(c:Integer): CharBytes;
FUNCTION ilength (VAR s : istring) : Integer;
FUNCTION GetArgument(VAR arg: istring): Boolean ;
PROCEDURE EnCodeParm(VAR data:istring);  (* encode parameters *)
PROCEDURE DeCodeParm(VAR data:istring); (* decode parameters *)
PROCEDURE Inverse( turn_on: Boolean ) ;
 
 
 

PRIVATE
 
 
 
IMPORTS IOErrors        FROM IOErrors ;
IMPORTS IO_Unit         FROM IO_Unit ;
IMPORTS IO_Others       FROM IO_Others ;
IMPORTS CmdParse        FROM CmdParse ;
IMPORTS Screen          FROM Screen ;
 
                                                   {$RANGE-}

FUNCTION UnChar(c:CharBytes): CharBytes;
   (* reverse of makechar *)
   BEGIN
      UnChar := c - BLANK
   END;
 
 
FUNCTION MakeChar(c:CharBytes): CharBytes;
   (* convert integer to printable *)
   BEGIN
      MakeChar := c + BLANK
   END;
 
FUNCTION IsControl(c:CharBytes): Boolean;
   (* true if control *)
   BEGIN
      (* Clear the 8th bit *)
      c := Land( c, #177 ) ;
      IsControl := (c = DEL) OR (c < BLANK)
   END;
 
FUNCTION IsPrintable(c:CharBytes): Boolean;
   (* opposite of iscontrol *)
   BEGIN
      IsPrintable := NOT IsControl(c)
   END;
 
FUNCTION Ctl(c:CharBytes): CharBytes;
   (* c XOR 100 *)
   BEGIN
      Ctl := LXor(c, #100)
   END;
 
FUNCTION IsValidPType(c:CharBytes): Boolean;
   (* true if valid packet type *)
   BEGIN
      IsValidPType := 
        c IN [TYPEB, TYPED, TYPEE, TYPEF, TYPEN, TYPES, TYPET, TYPEY, TYPEZ]
   END;
 
FUNCTION CheckFunction(c:Integer): CharBytes;
   (* calculate checksum *)
   VAR
      x: Integer;
   BEGIN
      (*   CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; *)
      x := Shift( Land(c, #300), -6) ;
      CheckFunction := Land(x+c, #077)
   END;
 
PROCEDURE EnCodeParm((* Updating *) VAR data:istring);  (* encode parameters *)
   VAR
      i: Integer;
   BEGIN
      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 *)
   END;
 
PROCEDURE DeCodeParm(VAR data:istring); (* decode parameters *)
   BEGIN
      SizeSend := UnChar(data[1]);
      TheirTimeOut := UnChar(data[2]);   (* when I should time out *)
      NumPad := 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 *)
   END;
 
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { length -- compute length of string }
FUNCTION ilength (VAR s : istring) : Integer;
   VAR
      n : Integer;
   BEGIN
      n := 1;
      WHILE (s[n] <> ENDSTR) DO
         n := n + 1;
      ilength := n - 1
   END;

 
 
PROCEDURE StartTimer;
   (* Start the time count, in clock ticks.  -pt*)
   BEGIN
      IOGetTime( OldTime ) ; (* Current clock value *)
      TimeLeft := TheirTimeOut * 60 (* in ticks *)
   END;
 
PROCEDURE CheckTimer ;
   (* Decrement "TimeLeft" by time between last call and now -pt*)
   VAR  now: Double ;
   BEGIN
      IF (TimeLeft > 0) THEN (* Still counting *)
         BEGIN
            IOGetTime( now ) ;
            TimeLeft := TimeLeft - now[0] + OldTime[0] ;
            OldTime := now
         END
   END ;

PROCEDURE StopTimer;
   BEGIN
      TimeLeft := Maxint;
   END;
 
 
(*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
 
 
PROCEDURE XmtChar(ch:Char);   (* Perq version -pt*)
   BEGIN
      WHILE IOCWrite(RS232Out, ch) <> IOEIOC DO (* nothing *) ;
   END;
 
 
FUNCTION GetIn :CharBytes;  (* get character *)
   (* Should return NULL (ENDSTR) if no characters, Perq version -pt*)
   VAR
      byte: CharBytes ;
      c :Char ;
   BEGIN
      IF (IOCRead(RS232In, c) = IOEIOC) THEN
         BEGIN
            byte := land( Ord(c), #377 ) (* [pgt001] *)
         END
      ELSE byte := ENDSTR ;
      GetIn := byte ;
      (* ChInPack := ChInPack + 1.0  (@ AddTo( x, 1)  *)
   END;
 
 
(*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
 
 
   (* Get the next argument from the command line -pt*)
   (* Return True if an argument is available - returned in "arg" too -pt*)
FUNCTION GetArgument(VAR arg: istring): Boolean ;
   VAR
      return: Boolean ;   (* Return value *)
      i, len: Integer ;   (* index and argument length *)
      id: String ;        (* Identifier/argument from the line *)
   BEGIN (*-GetArgument-*)
      dumCh := NextIDString( CmdLine, id, return ) ; (* Get an identifier *)
      IF (id = '') THEN return := False (* nothing *)
      ELSE
         BEGIN
            return := True ;       (* Success *)
            len := Length( id ) ;  (* get the string's length *)
            FOR i := 1 TO len DO   (* put the string in "arg" *)
               arg[i] := Ord( id[i] ) ;
            arg[len+1] := ENDSTR   (* finish it off *)
         END ;
      GetArgument := return
   END ; (*-GetArgument-*)

PROCEDURE Inverse( turn_on: Boolean ) ;
  (* Change chrsor function for inverse video *)
  BEGIN  (*-Inverse-*)
     IF turn_on THEN SChrFunc( RNot )
     ELSE  SChrFunc( RRpl )
  END    (*-Inverse-*).

(* <<<Stdio.Pas>>> *)
MODULE STDIO ;
(* Standard text file I/O *)
(* from Kernighan + Plauger *)
(* 29-Nov-83  Allow eight bit file transfer [pgt001] *)
(*            This forces us to make the end of (data) string value -1 *)
(*            and end of file value -2 because byte values can be 0..255 *)


EXPORTS

IMPORTS  KermitGlobals         FROM KermitGlobals ;

CONST
   { standard file descriptors. subscripts in open, etc. }
   STDIN = 1;              { these are not to be changed }
   STDOUT = 2;
   STDERR = 3;
   lineout = 4;
   linein = 5;
   FirstUserFile = STDERR ; (* First index available for user's files -pt*)
 
   { other io-related stuff }
   StdIOError = 0;    { status values for open files }
   StdIOAvail = 1;
   StdIORead = 2;
   StdIOWrite = 3;
   StdIO8Read = 4 ;  (* [pgt001] *)
   StdIO8Write = 5 ;  (* [pgt001] *)
   MAXOPEN = 15;   { maximum number of open files }
 
   { universal manifest constants }
   ENDFILE = ENDSTR - 1;  (* [pgt001] *)
 
TYPE
   filedesc = StdIOError..MAXOPEN;
   ioblock = RECORD        { to keep track of open files }
                filevar : Text;
                mode : StdIOError..StdIO8Write;
             END;
 
VAR
   openlist : ARRAY [1..MAXOPEN] OF ioblock; { open files }
 
PROCEDURE StdIOInit;
PROCEDURE putch (c : CharBytes);
PROCEDURE putcf (c : CharBytes; fd : filedesc);
PROCEDURE putstr (VAR s : istring; f : filedesc);
FUNCTION getch (VAR c : CharBytes) : CharBytes;
FUNCTION getcf (VAR c: CharBytes; fd : filedesc) : CharBytes;
FUNCTION getline (VAR s : istring; fd : filedesc;
                  maxsize : Integer) : Boolean;
 
FUNCTION Sopen (name : istring; mode :   Integer) : filedesc;
PROCEDURE Sclose (fd : filedesc);
FUNCTION Exists(s:istring): Boolean;

PRIVATE
 
 
IMPORTS  Perq_string    FROM Perq_String ;
IMPORTS  Stream         FROM Stream ;
IMPORTS  FileSystem     FROM FileSystem ;
 
 
   { StdIOInit  -- initialize open file list }
PROCEDURE StdIOInit;
   VAR
      i :     filedesc;
   BEGIN
      openlist[STDIN].mode := StdIORead;
      openlist[STDOUT].mode := StdIOWrite;
      { initialize rest of files      }
      FOR i := FirstUserFile TO MAXOPEN DO
         openlist[i].mode := StdIOAvail;
 
   END;
 
 
   { getc (UCB) -- get one character from standard input }
FUNCTION getch (VAR c : CharBytes) : CharBytes;
   VAR
      ch : Char;
   BEGIN
      IF Eof THEN c := ENDFILE
      ELSE
         IF Eoln THEN
            BEGIN
               Readln;
               c := LF
            END
         ELSE
            BEGIN
               Read(ch);
               c := Ord(ch)
            END;
      getch := c
   END;
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { getcf (UCB) -- get one character from file }
FUNCTION getcf (VAR c: CharBytes; fd : filedesc) : CharBytes;
   VAR
      ch : Char;
   BEGIN
    WITH  openlist[fd]  DO   (* [pgt001] *)
      IF (fd = STDIN) THEN getcf := getch(c)
      ELSE
         IF Eof(filevar) THEN  c := ENDFILE
         ELSE
           IF (mode = StdIO8Read) THEN (* [pgt001] *)
              BEGIN
                 c := Ord( filevar^ ) ;
                 Get( filevar )
              END                      (* [pgt001] *)
           ELSE
            IF Eoln(filevar) THEN
               BEGIN
                  Readln(filevar);
                  c := LF
               END
            ELSE
               BEGIN
                  Read(filevar, ch);
                  c := Ord(ch)
               END;
      getcf := c
   END;
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { getline (UCB) -- get a line from file }
FUNCTION getline (VAR s : istring; fd : filedesc;
                  maxsize : Integer) : Boolean;
   VAR
      i : Integer;
      c : CharBytes;
   BEGIN
      {$RANGE-}
      i := 1;
      REPEAT
         s[i] := getcf(c, fd);
         i := i + 1
      UNTIL (c = ENDFILE) OR (c = LF) OR (i >= maxsize);
      IF (c = ENDFILE) THEN i := i - 1 ;      { went one too far }
      s[i] := ENDSTR;
      getline := (c <> ENDFILE)
      {$RANGE+}
   END;
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { putch (UCB) -- put one character on standard output }
PROCEDURE putch (c : CharBytes);
   BEGIN
      IF (c = LF) THEN Writeln
      ELSE Write(Chr(c))
   END;
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { putcf (UCB) -- put a single character on file fd }
PROCEDURE putcf (c : CharBytes; fd : filedesc);
   CONST
      NUL = 0 ;
   BEGIN
    WITH  openlist[fd]  DO
      IF (fd = STDOUT) THEN putch(c)
      ELSE
       IF (mode = StdIO8Write) THEN (* [pgt001] *)
          BEGIN
             filevar^ := Chr(c) ;
             Put( filevar )
          END
       ELSE
         BEGIN  (* Normal text file [pgt001]*)
           c := Land(c, #177) ;    
           IF (c = LF) THEN   Writeln(filevar)
           ELSE
             IF (c = CR) OR (c = NUL) THEN (* ignore *)
             ELSE
              Write(filevar, Chr( c ))
         END ;
   END;
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { putstr (UCB) -- put out string on file }
PROCEDURE putstr (VAR s : istring; f : filedesc);
   VAR
      i : Integer;
   BEGIN
      {$RANGE-}
      i := 1;
      WHILE (s[i] <> ENDSTR) DO
         BEGIN
            putcf(s[i], f);
            i := i + 1
         END
      {$RANGE+}
   END;
 
 
   { MakeString -- Convert an istring into a Perq String variable -pt }
PROCEDURE MakeString(src: istring; VAR dest: String) ;
   VAR
      i: Integer ;
   BEGIN (*-MakeString-*)
      i := 1 ;
      {$RANGE- Checks off because Length(dest) undefined at the moment -pt}
      WHILE (src[i] <> ENDSTR) AND (src[i] <> LF) DO
         BEGIN
            dest[i] := Chr(src[i]) ;
            i := i + 1
         END ;
      {$RANGE+  Checks back on -pt}
      Adjust(dest, i-1)   (* Set the dynamic length -pt*)
   END ; (*-MakeString-*)
 
   { open  -- open a file for reading or writing.   Perq version -pt}
FUNCTION Sopen (name : istring; mode :   Integer) : filedesc;
   VAR
      i :     Integer;
      filename : String ;
      found : Boolean;
 
      (* Reset and Rewrite error handlers. Both set "sopen" to IOERROR   -pt*)
      (* This means we set inital value of "sopen" before reset/rewrite  -pt*)
   HANDLER ResetError(filnam: PathName) ;
      BEGIN
         sopen := StdIOError
      END ;
   HANDLER RewriteError(filnam: PathName) ;
      BEGIN
         sopen := StdIOError
      END ;
 
   BEGIN
      MakeString(name, filename) ; (* Convert to Perq string -pt*)
      { find a free slot in openlist }
      Sopen := StdIOError;
      found := False;
      i := 1;
      WHILE (i <= MAXOPEN) AND (NOT found) DO
         BEGIN
            IF (openlist[i].mode = StdIOAvail) THEN
               BEGIN
                  openlist[i].mode := mode ;
                  Sopen := i;  (* Here so file handlers can reset value -pt*)
                  IF (mode = StdIORead) OR (mode = StdIO8Read) THEN
                     Reset(openlist[i].filevar, filename)  (* [pgt001] *)
                  ELSE
                     Rewrite(openlist[i].filevar, filename);
                  found := True
               END;
            i := i + 1
         END
   END;
 
PROCEDURE Sclose (fd : filedesc);
   BEGIN
      IF (fd >= FirstUserFile) AND (fd <= MAXOPEN) THEN
         BEGIN
            openlist[fd].mode := StdIOAvail;
            close(openlist[fd].filevar);
         END
   END;
 
 
FUNCTION Exists(s:istring): Boolean;
   (* returns true if file exists. Perq version -pt*)
   VAR
      name: String ;
      file_id, blocks, bits: Integer ;
   BEGIN        (*-Exists-*)
      (* Be quick and use a look-up; better than open/close sequence  -pt*)
      MakeString(s, name) ;        (* Get the file name as a Perq string *)
      file_id := FSLookUp(name, blocks, bits) ; (* Do the look-up *)
      Exists := (file_id <> 0)     (* Zero means it does not exist *)
   END.         (*-Exists-*)