PROGRAM KERMIT;
(*********************************************************************)
(*                                                                   *)
(*    KERMIT  - File transfer Program for MVS/TSO                    *)
(*              ( and RACF file access control )                     *)
(*    Author  - Fritz Buetikofer (M70B@CBEBDA3T.BITNET)              *)
(*    Version - 2.3                                                  *)
(*    Date    - 1987 August                                          *)
(*                                                                   *)
(*    This program is an adaptation of the original CMS version of   *)
(*    Victor Lee. Due to a big difference between CMS and TSO, most  *)
(*    parts of the program had to be changed.                        *)
(*                                                                   *)
(*********************************************************************)
(*                                                                   *)
(*  1985 Sept 10  Program is totally changed for use with MVS/XA TSO *)
(*                without any Series/1 frontend processor.           *)
(*  1985 Oct  15  Commands DISK, DIR, DELETE, TYPE and WHO added     *)
(*                for those users, not very experienced with TSO.    *)
(*  1985 Oct  24  Correct treatment of the 'repetition' char.        *)
(*  1985 Oct  29  Check of the sequence of data packets from the     *)
(*                micro. Old packets are skipped by an ACK.          *)
(*  1985 Nov  14  Correct handling of the 8th bit quoting for text   *)
(*                files (according to the 2 translation tables).     *)
(*  1985 Nov  22  Warning to user, if using a 327x-alike terminal-   *)
(*                emulator (fullscreen support not available yet).   *)
(*  1986 Jan  03  New command MEMBER added for partitionned files    *)
(*  1986 Jan  13  Wildcard procedure added for sending files.        *)
(*  1986 Feb  03  Setup Option added, using TSO file KERMIT.SETUP    *)
(*                if present.                                        *)
(*            05  Remote help file built in.                         *)
(*  1986 Feb  18  KERMIT may issue FINISH command to micro running   *)
(*                actually in server mode.                           *)
(*  1986 Apr  04  SET REPEATCHAR, SET SOHchar and SET option ?       *)
(*                facility added                                     *)
(*  1986 May  07  TAKE command added, to execute commands from an    *)
(*                external file.                                     *)
(*  1986 May  14  Display in STATUS screen, whether Init-file has    *)
(*                been processed or not.                             *)
(*  1986 May  23  SET ATOE/ETOA added to modify the ASCII<->EBCDIC   *)
(*                translation table on running KERMIT program.       *)
(*  1986 June 16  SET INCOMPLETE added to control the disposition of *)
(*                an incomplete incoming file.                       *)
(*  1986 Aug  28  Command SEND filename updated, so the user can spe-*)
(*                cify the name going to the micro.                  *)
(*********************************************************************)
(*  After a period of other work to be done, I found again some time *)
(*  to implement a brand new feature: long packets !                 *)
(*                                                                   *)
(*  1987 Jan  19  Abort Remote_Help or Remote_Dir if not ACK or NAK  *)
(*                is received (return to server_init state).         *)
(*  1987 Jan  23  Implementation of long packets done. For test use  *)
(*                I restricted the max. length to 1024 = 1K, which   *)
(*                seems to be adequate for use over LANs.            *)
(*                As soon as pack.length exceeds 256 bytes, the      *)
(*                checktype is automatically set to 3=CRC.           *)
(*  1987 Jan  30  Modifications in SendPacket and RecvPacket, be-    *)
(*                cause they handled the checktype wrong.            *)
(*  1987 Mar  25  Modification in Main Program, so that the first    *)
(*                packet received in SERVER-mode is handled correct. *)
(*  1987 Mar  27  Implementation of the ATTRIBUTE packets. Addition  *)
(*                of the command DO, which executes members taken    *)
(*                from the partitioned dataset KERMIT.PROFILE.       *)
(*  1987 Aug  15  Corrections in routine SENDFILE, so that ACKs are  *)
(*                checked with the actual sequence.                  *)
(*                                                                   *)
(*********************************************************************)
(*                                                                   *)
(*  1.   This version of kermit will handle binary files,            *)
(*       i.e. it will handle 8th bit quoting.                        *)
(*                                                                   *)
(*  2.   By default all characters received are converted from       *)
(*       ASCII and stored as EBCDIC. Also all characters send are    *)
(*       converted from EBCDIC to ASCII.  To avoid the translation   *)
(*       for non-text file you must set TEXT OFF.                    *)
(*                                                                   *)
(*  3.   This version contains a slot for all the documented         *)
(*       advanced server functions, however only some are implemented*)
(*                                                                   *)
(*********************************************************************)
(*                                                                   *)
(*  Utility Procedures:                                              *)
(*       SendPacket      RecvPacket    ReSendit     TSOService       *)
(*       SendACK         GetToken      Wait         UPCase           *)
(*       TRead           TWrite        Prompt       InPacket         *)
(*       OutPacket       TermSize      CheckDsn     Extract          *)
(*       CRCheck         SendChar      CheckParms   Micro_Finish     *)
(*       RecvChar        SendError     ParmPacket   FileToPacket     *)
(*       Wildcard_Search Write_State                                 *)
(*                                                                   *)
(*                                                                   *)
(*  Command Procedures                                               *)
(*       SendFile  - Sends a file to another computer.               *)
(*       RecvFile  - Receive a file from another computer.           *)
(*       ShowIT    - Display the options and status of last tranfer. *)
(*       SetIT     - Set the options.                                *)
(*       Help      - Displays the commands available.                *)
(*       RemoteCommand - handle commands initiated by micro.         *)
(*                                                                   *)
(*********************************************************************)
%TITLE Declarations
TYPE
    LString   = STRING (256);
    FString   = PACKED ARRAY (.1..256.) OF CHAR;
    LPString  = STRING (1024);
    PString   = PACKED ARRAY (.1..1024.) OF CHAR;
    BYTE      = PACKED 0..255;
    TWOBYTES  = PACKED 0..65535;
    OVERLAY   = (ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE);
    PACKET    = RECORD CASE OVERLAY OF
                 ONE   :( CHARS : PACKED ARRAY (.1..1024.) OF CHAR );
                 TWO   :( BYTES : PACKED ARRAY (.1..1024.) OF BYTE )
                END;

    STATETYPE = (S_I,S,SF,SD,SZ,SB,C,A,R,RF,RD);

    ABORTTYPE = (NOSOH,BADSF,NOT_S,NOT_SFBZ,NOT_DZ);

    DISPTYPE  = (NEW, NEWMEM, OLD, OLDMEM, SHARE,
                 MODIFY, ERROR, NOACC, BADNAME, NOMEM);

    COMMANDS  = ($BAD,  $SEND,   $RECEIVE, $SERVER, $SET,
                 $SHOW, $STATUS, $HELP,    $QUES,   $DEL,
                 $DIR,  $DISK,   $MEM,     $TSO,    $TYPE,
                 $WHO,  $FINISH, $QUIT,    $END,    $EXIT,
                 $DO,   $LOG,    $TAKE,    $VERSION);

    WHATFLAGS = ($ZERO,        $TEXTMODE,
                 $EXTEND1,
                 $RECFM,       $PACKETSIZE,
                 $EXTEND2,     $EOLCHAR,
                 $CNTRL_QUOTE, $EXTEND3,
                 $BIT8_QUOTE,  $EXTEND4,
                 $CHECKTYPE,   $EXTEND5,
                 $DELAY,       $DEBUG,
                 $REPCHAR,     $EXTEND6,
                 $SOHCHAR,     $ATOE,
                 $ETOA,        $INCOMPLETE,
                 $EXTEND7,     $DUMMY);

 CONST
    COMMTABLE = 'BAD     ' ||
                'SEND    ' ||
                'RECEIVE ' ||
                'SERVER  ' ||
                'SET     ' ||
                'SHOW    ' ||
                'STATUS  ' ||
                'HELP    ' ||
                '?       ' ||
                'DELETE  ' ||
                'DIR     ' ||
                'DISK    ' ||
                'MEMBERS ' ||
                'TSO     ' ||
                'TYPE    ' ||
                'WHO     ' ||
                'FINISH  ' ||
                'QUIT    ' ||
                'END     ' ||
                'EXIT    ' ||
                'DO      ' ||
                'LOGOUT  ' ||
                'TAKE    ' ||
                'VERSION ';

    WHATTABLE = 'BAD     ' ||
                'TEXTMODE' ||
                '        ' ||
                'RECFM   ' ||
                'PACKETSI' ||
                'ZE      ' ||
                'EOLCHAR ' ||
                'CNTRL_QU' ||
                'OTE     ' ||
                'BIT8_QUO' ||
                'TE      ' ||
                'CHECKTYP' ||
                'E       ' ||
                'DELAY   ' ||
                'DEBUG   ' ||
                'REPEATCH' ||
                'AR      ' ||
                'SOHCHAR ' ||
                'ATOE    ' ||
                'ETOA    ' ||
                'INCOMPLE' ||
                'TE      ' ||
                'DUMMY   ';

    SPECTABLE = '00'XC || '!"#$%&''()*+,-./:;<=>{|}~';

    DCB_Fix   = 'RECFM(F,B) LRECL(80)   BLKSIZE(6160)'; (* Fixed    *)
    DCB_Var   = 'RECFM(V,B) LRECL(255)  BLKSIZE(3024)'; (* Variable *)
    DCB_Bin   = 'RECFM(U)   LRECL(1024) BLKSIZE(6144)'; (* Binary   *)
    DCB_DEBUG = 'RECFM(V,B) LRECL(255) BLKSIZE(6200)';
    DEBUGNAME = 'KERMIT.DEBUG';         (* Name of DEBUG   data set *)
    CMDNAME   = 'KERMIT.SETUP';         (* Name of SETUP   data set *)
    PROFNAME  = 'KERMIT.PROFILE';       (* Name of PROFILE data set *)

VAR
    RUNNING,
    EndKermit,
    GetFile,
    EOLINE,
    Remote,
    CmdMode,
    Init_File,
    GETREPLY       : BOOLEAN;
    COMMAND,
    SETTING        : ALFA;
    REQUEST        : STRING (9);
    CINDEX,
    CHECKBYTES,
    I,J,K,LEN,RC,
    ScreenSize     : INTEGER;
    Handle_Attribute,
    Long_Packet,
    TEXTMODE, FB   : BOOLEAN;
    UserID         : STRING (8);
    STATE          : STATETYPE;
    ABORT          : ABORTTYPE;
    DsnDisp        : DISPTYPE;
    INPUTSTRING,                              (* Command string *)
    TSOCommand     : LString;                (* TSO command string *)
    Line           : LPString;
    (* Packet variables *)                        (* format   *)
    (* Receive       Send     *)                  (* SOH      *)
    INCOUNT,      OUTCOUNT,                       (* COUNT    *)
    INDATACOUNT,  OUTDATACOUNT  : INTEGER;        (* Chr-COUNT*)
    INSEQ,        OUTSEQ        : BYTE;           (* SEQNUM   *)
    INPACKETTYPE, OUTPACKETTYPE : CHAR;           (* TYPE     *)
    REPLYMSG,     SENDMSG       : PACKET;         (* DATA...  *)
    CHECKSUM                    : INTEGER;        (* CHECKSUM *)
    CRC                         : TWOBYTES;       (* CRC-CCITT*)

    SENDBUFF,RECVBUFF : PACKET;
    MAXLENGTH,SI,RI,RECVLENGTH,FC : TWOBYTES;
    TSODS,                            (* File with TSO info *)
    DFILE,                            (* DEBUG-Info file    *)
    CmdFile,                          (* SETUP file         *)
    SFILE     : TEXT;                 (* SEND file          *)
    FileCount : INTEGER;
    FileList  : ARRAY (.1..100.) OF LString;

STATIC
    ASCIITOEBCDIC,
    EBCDICTOASCII           : PACKED ARRAY (.1..255.) OF CHAR;
    CAPAS,
    PSIZE, ECHAR, SCHAR     : INTEGER;
    CNTRL_QUOTE, BIT8_QUOTE,
    CHECKTYPE, REPEATCHAR,
    SeqChar, LastSeq, SOH   : CHAR;
    Delay                   : REAL;
    Debug, RECEIVING,
    Incomplete_File         : BOOLEAN;
    CRLF                    : STRING (4);

VALUE
    PSIZE       := 94;        (* PACKET size = 94 (maximum) *)
    SOH         := '01'XC ;   (* Start of packet - <Ctrl>-A *)
    ECHAR       := 13;        (* End of line char - CR  *)
    SCHAR       := 1;
    CAPAS       := 0;
    CNTRL_QUOTE := '#';
    BIT8_QUOTE  := '&';
    CHECKTYPE   := '1';       (* 1 BYTE checksum *)
    Delay       := 6.0;       (* Wait-factor = 6 seconds *)
    Debug       := FALSE;     (* No debugging first    *)
    REPEATCHAR  := '~';       (* Repeat quote *)
    CRLF        := '#M#J';    (* String with CR, LF *)
    SeqChar     := '31'XC;    (* Initial value *)
    Incomplete_File := TRUE;  (* Keep/Discard incomplete file *)

(* THIS IS THE EXTENDED-ASCII TO EBCDIC TABLE, TYPE SWISS *)
    ASCIITOEBCDIC :=
           '010203372D2E2F1605250B0C0D0E0F'XC ||  (* 0. *)
         '100000003C3D322618193F271C1D1E1F'XC ||  (* 1. *)
         '404F7F7B5B6C507D4D5D5C4E6B604B61'XC ||  (* 2. *)
         'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'XC ||  (* 3. *)
         '7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'XC ||  (* 4. *)
         'D7D8D9E2E3E4E5E6E7E8E94AE05A5F6D'XC ||  (* 5. *)
         '79818283848586878889919293949596'XC ||  (* 6. *)
         '979899A2A3A4A5A6A7A8A9C06AD0A107'XC ||  (* 7. *)
         '48DC51424344814852535457565863C1'XC ||  (* 8. *)
         'C50000CBCCCDDBDDA8ECFC00B1000086'XC ||  (* 9. *)
         '455596DE49D58196005F000000000000'XC ||  (* A. *)
         '000000FAEDEDEDBCBCEDFABCBBBBBBBC'XC ||  (* B. *)
         'ABCECFEBBF8FEBEBABACCECFEBBF8FCE'XC ||  (* C. *)
         'CECFCFABABACAC8F8FBBAC0000000000'XC ||  (* D. *)
         '00000000000000000000000000000000'XC ||  (* E. *)
         '00000000000000000000AF0000009F00'XC;    (* F. *)
(*  THIS IS THE EBCDIC TO EXTENDED-ASCII CONVERSION TABLE (SWISS)  *)
(*   CHARACTERS NOT REPRESENTABLE IN ASCII ARE REPLACED BY A NULL  *)
    EBCDICTOASCII :=
           '0102030009007F0009000B0C0D0E0F'XC ||  (* 0. *)
         '10202020000D0800181900001C1D1E1F'XC ||  (* 1. *)
         '00000000000A171B0000000000050607'XC ||  (* 2. *)
         '0000160000000004000000001415001A'XC ||  (* 3. *)
         '2020838485A0000087A45B2E3C282B21'XC ||  (* 4. *)
         '268288898AA18C8B8D005D242A293B5E'XC ||  (* 5. *)
         '2D2F008E0000000000007C2C255F3E3F'XC ||  (* 6. *)
         '000000000000000000603A2340273D22'XC ||  (* 7. *)
         '006162636465666768690000002800C5'XC ||  (* 8. *)
         '006A6B6C6D6E6F7071720000002900FE'XC ||  (* 9. *)
         '007E737475767778797A00C0DA5B00FA'XC ||  (* A. *)
         '009C000000000000000000D9BF5D00C4'XC ||  (* B. *)
         '7B41424344454647484900939495C1C2'XC ||  (* C. *)
         '7D4A4B4C4D4E4F50515200968197A300'XC ||  (* D. *)
         '5C00535455565758595A00C399B40000'XC ||  (* E. *)
         '30313233343536373839B3009A000000'XC ;   (* F. *)

LABEL MAINLOOP;
%TITLE Special TSO Routines
(*==================================================================*)
(* TSOService  - This procedure executes all TSO command requests.  *)
(*==================================================================*)
(* The following routine resides in the LPA -> Pgm must be loaded *)
PROCEDURE IKJEFTSR (CONST P1 : INTEGER; CONST P2 : FString;
                    VAR P3, P4, P5, P6 : INTEGER); FORTRAN;

PROCEDURE TSOService (CONST Cmd : LString; VAR Code : INTEGER);

VAR
  Command       : FString;
  a, b, c, d, e : INTEGER;

BEGIN
  a := 257; c := 0; d := 0;   e := 0;
  Command := Cmd; b := LENGTH (Cmd);
  IKJEFTSR (a, Command, b, c, d, e);
  Code := c
END (* TSOService *);

(*==================================================================*)
(* Waiting     - This procedure waits 'w' seconds before proceeding *)
(*==================================================================*)
PROCEDURE Wait (CONST i : INTEGER); FORTRAN;     (* Pause i seconds *)
PROCEDURE Waiting (w : REAL);
TYPE
  Convert = RECORD
               CASE BOOLEAN OF
                 TRUE  : ( Int  : INTEGER);
                 FALSE : ( Chrs : PACKED ARRAY (.1..4.) OF CHAR);
            END;
VAR
  I    : INTEGER;
  Fact : Convert;
BEGIN
  I := TRUNC (w * 100);
  Fact.Chrs (.1.) := CHR (0);
  Fact.Chrs (.2.) := CHR (0);
  Fact.Chrs (.3.) := CHR (I DIV 256);
  Fact.Chrs (.4.) := CHR (I MOD 256);
  Wait (Fact.Int)
END (* Waiting *);


PROCEDURE UPCASE (VAR S : ALFA);
VAR i  : INTEGER;
    ch : CHAR;
BEGIN
  FOR i := 1 TO LENGTH (S) DO BEGIN
      ch := S (.i.);
      IF ch IN (.'a'..'z'.) THEN S (.i.) := CHR ( ORD (ch) + 64)
  END
END;
%PAGE
PROCEDURE TRead     (CONST Prompt : FString;
                     CONST Prompt_Len : INTEGER;
                     VAR   Message : PString;
                     VAR   M_Len, RC : INTEGER); FORTRAN;

(*==================================================================*)
(* Prompt      - This procedure prompts the user for input          *)
(*==================================================================*)

PROCEDURE Prompt (p : LString; VAR s : LString);

VAR
  m     : FString;
  n     : PString;
  i,j,k : INTEGER;

BEGIN
  m := p; i := LENGTH (p);
  TRead (m, i, n, j, k);
  s := SUBSTR (STR (n), 1, j) || ' '
END;

(*==================================================================*)
(* InPacket   - This procedure reads a packet from the terminal     *)
(*==================================================================*)

PROCEDURE InPacket (VAR s : LPString);

VAR
  m     : FString;
  n     : PString;
  i,j,k : INTEGER;

BEGIN
  m := ''; i := 0;
  TRead (m, i, n, j, k);
  s := SUBSTR (STR (n), 1, j) || ' '
END;
(*==================================================================*)
(* OutPacket   - This procedure writes a packet to the terminal     *)
(*==================================================================*)
PROCEDURE TWrite    (CONST Line : PString;
                     CONST Len  : INTEGER;
                     VAR   RC   : INTEGER); FORTRAN;

PROCEDURE OutPacket (l : LPString);

VAR
  m   : PString;
  i,j : INTEGER;

BEGIN
  m := l; i := LENGTH (l);
  TWrite (l, i, j)
END;

(*==================================================================*)
(* TermSize    - This procedure reads the screen size of the other  *)
(*               Kermit terminal's emulator.                        *)
(*==================================================================*)
PROCEDURE TermSize  (VAR a : INTEGER); FORTRAN;
%PAGE
FUNCTION Upper (S : LString) : LString;
VAR i  : INTEGER;
    ch : CHAR;
BEGIN
  Upper := S;
  FOR i := 1 TO LENGTH (S) DO BEGIN
      ch := S (.i.);
      IF ch IN (.'a'..'z'.) THEN Upper (.i.) := CHR ( ORD (ch) + 64)
  END
END;

(*==================================================================*)
(* CheckDsn    - This procedure verifies whether a data set exists  *)
(*               and if so, it prompts the user for a new name.     *)
(*==================================================================*)
PROCEDURE CheckDsn (VAR KFile : LString; VAR Result : DISPTYPE);

CONST
    RelId = '00000001';

VAR TSODS : TEXT;
    InFile,
    Line  : LString;
    Name  : STRING (20);
    Dot,Num,
    Col   : INTEGER;
    IsPDS : BOOLEAN;

  PROCEDURE NewChar (VAR L : LString; N : INTEGER);
  CONST
    Charset = '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ'; (* 36 items *)
  VAR
    Chg : CHAR;
    j   : INTEGER;
  BEGIN
    Chg := L (.N.);
    j   := INDEX (Charset, STR (Chg));
    j   := j + 1;
    IF j > 36 THEN j := 1;
    Chg := Charset (.j.);
    L (.N.) := Chg
  END;

BEGIN
  InFile := Upper (KFile);
  IF InFile (.1.) <> '''' THEN
     InFile := '''' || UserID || '.' || InFile || '''';
  IF Debug THEN WRITELN (DFILE, 'Checking data set ', InFile);
  TSOService ('PROFILE NOPROMPT',  RC);
  TSOService ('TSODS LISTDS ' || InFile || ' MEM', RC);
  TSOService ('PROFILE PROMPT',  RC);
  RESET   (TSODS);
  READLN  (TSODS, Line);
  IF Debug THEN WRITELN (DFILE, Line);
  (* -------------------------------------*)
  (* Maybe filename is invaild            *)
  (* -------------------------------------*)
  IF INDEX (Line, 'INVALID DATA SET') > 0 THEN
    IF NOT GetFile THEN Result := BADNAME
    ELSE BEGIN
      (* TSO Kermit got an invalid data set name from micro *)
      (* ... will try now to write data to a temporary file *)
      (* called KERMIT.TEMP                                 *)
      IF Debug THEN WRITELN (DFile, KFile || ' renamed to KERMIT.TEMP');
      KFile := 'KERMIT.TEMP';
      CheckDsn (KFile, Result)
    END
  ELSE BEGIN
    READLN  (TSODS, Line);
    IF Debug THEN WRITELN (DFILE, Line);
    (* -------------------------------------*)
    (* Maybe file is not in catalog         *)
    (* -------------------------------------*)
    IF INDEX (Line, 'NOT IN CATALOG') > 0 THEN Result := NEW
    ELSE BEGIN
      Result := SHARE;
      IsPDS  := FALSE;
      READLN  (TSODS, Line);
      IF INDEX (Line, 'PO') > 0 THEN BEGIN (* Dsn is partitioned *)
         IsPDS  := TRUE;
         IF INDEX (KFile, '(') = 0 THEN BEGIN (* No member for PDS *)
            Result := ERROR;
            IF NOT GetFile THEN Result := NOMEM;
            IF Debug THEN WRITELN (DFILE, 'No member specified !!');
            RETURN
         END;
         READLN  (TSODS, Line); READLN  (TSODS, Line);
         READLN  (TSODS, Line); READLN  (TSODS, Line);
         IF Debug THEN WRITELN (DFILE, Line);
         IF INDEX (Line, 'NOT FOUND') > 0 THEN Result := NEWMEM
            ELSE Result := OLDMEM
      END
    END
  END;
  CLOSE (TSODS);
  IF NOT GetFile THEN
     IF (Result = SHARE) OR (Result = OLDMEM) THEN BEGIN
        TSOService ('TSODS LISTCAT ENT(' || InFile || ')', RC);
        IF RC <> 0 THEN BEGIN
          IF Debug THEN WRITELN (DFILE, 'No access to file ' || InFile);
          Result := NOACC
        END
     END;
  IF GetFile THEN
   CASE Result OF
     NEW,
     NEWMEM : (* New data set or member *);
     ERROR  : (* Do nothing yet *);
     OLDMEM,
     SHARE  : BEGIN
                IF Remote THEN Num := 3
                ELSE BEGIN
                  WRITELN ('Data set or member already exists ...');
                  WRITELN (' ');
                  WRITELN ('    (1) Overwrite it ? ');
                  WRITELN ('    (2) Append to file ? ');
                  WRITELN (' or (3) create new file name ? ');
                  READLN  (Num);
                  IF (Num < 1) OR (Num > 3) THEN Num := 3
                END;
                CASE Num OF
                  1 : Result := OLD;
                  2 : Result := MODIFY;
                  3 : BEGIN
                        InFile := KFile;
                        Col := INDEX (InFile, '(');
                        IF IsPDS THEN Col := INDEX (InFile, ')');
                        Num := LENGTH (InFile);
                        IF Col > 0 THEN NewChar (InFile, Col - 1)
                                   ELSE NewChar (InFile, Num);
                        KFile := InFile;
                        IF Debug THEN
                           WRITELN (DFILE, 'Trying with ', KFile);
                        CheckDsn (KFile, Result)
                      END
                  END
                END
     END
END;


(*================================================================*)
(* Extract   - This procedure constructs a KERMIT filename from   *)
(*             a TSO data set name.                               *)
(*================================================================*)
PROCEDURE Extract (Filename : LString; VAR KermName : LString);

VAR Name, Typ : String(8);
    PDS,Dot,i : INTEGER;

BEGIN
  Filename := LTRIM (Filename);
  Dot := INDEX (Filename, '.') + 1;
  IF Filename (.1.) = '''' THEN
     Filename := SUBSTR (Filename, Dot , LENGTH (Filename)-Dot);
  Typ := '';
  PDS := INDEX (Filename, '(');
  Dot := INDEX (Filename, '.');
  IF PDS > 0 THEN BEGIN
    i    := INDEX (Filename, ')');
    Name := SUBSTR (Filename, PDS+1, i-PDS-1);
    Filename := DELETE (Filename, PDS)
  END ELSE
    IF Dot > 0 THEN BEGIN
      Name := SUBSTR (Filename, 1, Dot-1);
      Filename := SUBSTR (Filename, Dot+1)
    END ELSE
      BEGIN Name := Filename; Filename := '' END;
  IF Filename <> '' THEN
    REPEAT
      Dot := INDEX (Filename, '.');
      IF Dot > 0 THEN Filename := SUBSTR (Filename, Dot+1)
                 ELSE BEGIN Typ := Filename; Filename := '' END;
    UNTIL Filename = '';
  IF Typ = '' THEN KermName := Name
     ELSE KermName := Name || '.' || Typ;
END;
%PAGE
(*==================================================================*)
(* Wildcard_Search:  This procedure generates a list of filenames,  *)
(*                   which follow a given mask.                     *)
(*==================================================================*)
PROCEDURE Wildcard_Search (VAR S : LString);

VAR Flag   : BOOLEAN;
    Line,
    DSname : LString;
    User   : STRING (8);
    Mask1,
    Mask2,
    Name,
    FullDsn,
    Level  : STRING (40);
    Len1, Len2,
    Star,                   (* Position of '*' in filename  *)
    Dot,                    (* Position of '.' in filename  *)
    ParOp,                  (* Position of '(' in filename  *)
    ParCl  : INTEGER;       (* Position of ')' in filename  *)

BEGIN
  FileCount := 0;
  S := Upper (S);
  IF INDEX (S, '*') = 0 THEN BEGIN
     FileCount := 1;
     FileList (.1.) := S;
     RETURN
  END;
  IF S(.1.) = '''' THEN BEGIN
     Dot  := INDEX (S, '.');
     User := SUBSTR (S, 2, Dot-2);
     S    := SUBSTR (S, Dot+1, LENGTH (S)-Dot-1);
  END ELSE User := UserId;
  DSname := S;
  Star   := INDEX (S, '*');
  IF Star < LENGTH (S) THEN BEGIN
     Line   := SUBSTR (S, Star+1);
     IF INDEX (Line , '*') > 0 THEN BEGIN
        WRITELN (' No double wildcard allowed ');
        RETURN
     END
  END;
  Dot    := INDEX (S, '.');
  ParOp  := INDEX (S, '(');
  IF ParOp > 0 THEN BEGIN
     ParCl  := INDEX (S, ')');
     DSname := SUBSTR (S, 1, ParOp-1);
     IF Star > ParOp THEN BEGIN   (* He would like all PDS members *)
        Mask1 := ' '; Mask2 := ' ';
        IF Star > ParOp + 1 THEN
           Mask1 := SUBSTR (S, ParOp+1, Star-ParOp-1);
        IF Star < Parcl - 1 THEN BEGIN
           Mask2 := SUBSTR (S, Star+1, ParCl-Star-1);
           Len2  := LENGTH (Mask2)
        END;
        FullDsn := '''' || User || '.' || DSname || '''';
        TSOService ('TSODS LISTD ' || FullDsn || ' m', RC);
        RESET  (TSODS);
        READLN (TSODS, Line);
        IF INDEX (Line, 'NOT IN CATALOG') > 0 THEN RETURN;
        READLN (TSODS, Line);
        READLN (TSODS, Line);
        IF INDEX (Line, 'PO') = 0 THEN BEGIN
           FileCount := FileCount + 1;
           IF User = UserID THEN FileList (.FileCount.) := DSNAME
           ELSE FileList (.FileCount.) :=
                '''' || User || '.' || DSNAME || '''';
           RETURN;  (* File is not a PDS *)
        END;
        READLN (TSODS, Line);
        READLN (TSODS, Line);
        READLN (TSODS, Line);
        WHILE NOT EOF (TSODS) DO BEGIN
          READLN (TSODS, Line);
          IF INDEX (Line, 'NOT USEABLE') > 1 THEN BEGIN
             CLOSE (TSODS);
             RETURN
          END;
          Line := LTRIM (Line);
          Len1 := LENGTH (Line);
          Flag := TRUE;
          IF Mask1 <> ' ' THEN
             IF INDEX (Line, Mask1) <> 1 THEN Flag := FALSE;
          IF Mask2 <> ' ' THEN
             IF SUBSTR (Line, Len1-Len2+1, Len2) <> Mask2 THEN
                Flag := FALSE;
          IF Flag THEN BEGIN
             FileCount := FileCount + 1;
             IF User = UserID THEN FileList (.FileCount.) :=
                DSNAME || '(' || Line || ')'
             ELSE FileList (.FileCount.) :=
             '''' || User || '.' || DSNAME || '(' || Line || ')''';
          END;
        END;
        CLOSE  (TSODS)
     END
  END ELSE
  IF ParOp > 0 THEN RETURN
     ELSE BEGIN
       Name := SUBSTR (S, 1, Dot-1);
       Level := 'LEV(' || User || ')';
       TSOService ('TSODS LISTCAT ' || Level, RC);
       Mask1 := User; Mask2 := ' ';
       IF Star > 1 THEN
          Mask1 := Mask1 || '.' || SUBSTR (S, 1, Star-1);
       IF LENGTH (S) > Star THEN BEGIN
          Mask2 := SUBSTR (S, Star+1);
          Len2  := LENGTH (Mask2)
       END;
       RESET  (TSODS);
       REPEAT
         READLN (TSODS, Line);
         IF INDEX (Line, 'THE NUMBER OF') <> 0 THEN LEAVE;
         IF INDEX (Line, 'SECURITY VERIFICATION') <> 0 THEN
            READLN (TSODS, Line)
         ELSE BEGIN
            Line := SUBSTR (Line, 17);
            Len1 := LENGTH (Line);
            Flag := TRUE;
            IF Mask1 <> ' ' THEN
               IF INDEX (Line, Mask1) <> 1 THEN Flag := FALSE;
            IF Mask2 <> ' ' THEN
               IF SUBSTR (Line, Len1-Len2+1, Len2) <> Mask2 THEN
                  Flag := FALSE;
            IF Flag THEN BEGIN
               FileCount := FileCount + 1;
               IF User = UserID THEN
                FileList (.FileCount.) := SUBSTR (Line, LENGTH(User)+2)
               ELSE FileList (.FileCount.) := '''' || Line || ''''
            END
         END;
         READLN (TSODS, Line)
       UNTIL EOF (TSODS);
       CLOSE (TSODS)
     END
END; (* Wildcard_Search *)

%TITLE KERMIT Utilities
(* ===============================================================  *)
(* CRCheck  -  This procedure generates a CRC (CCITT) .             *)
(*             The generator polynomial is X^16+X^12+X^5+1          *)
(*             which is 1021 hex or the reverse 8408 hex            *)
(* Side Effect - The global variable CRC is updated. The CRC should *)
(*               be zero at the start of each CRC calculation and   *)
(*               should be called once for each byte to checked.    *)
(*               no other call to this procedure is necessary.      *)
(*              The CRC is done on all 8 bits in the byte.          *)
(* ===============================================================  *)
PROCEDURE CRCheck(MYBYTE : BYTE);
VAR
 j,c,t : INTEGER;
BEGIN
  c := MYBYTE;
  FOR j := 0 TO 7 DO BEGIN
    t   := CRC && c;
    CRC := CRC >> 1;
    IF ODD (t) THEN CRC := CRC && '8408'X;
    c   := c >> 1
  END
END; (* CRCheck *)

(*================================================================*)
(* SendChar -  This procedure sends a char to the terminal.       *)
(* Side Effect - none                                             *)
(*================================================================*)
PROCEDURE SendChar (VAR L : LPString; MyChar : CHAR);
BEGIN
  L := L || STR (MyChar);
  IF MyChar = '0D'XC THEN OutPacket (L)
END;  (* Send Char *)

(* ===============================================================*)
(* RecvChar -  This procedure gets a char from string L.          *)
(* Side Effect - EOLINE is set                                    *)
(* ===============================================================*)
PROCEDURE RecvChar (VAR L : LPString; VAR MyChar : CHAR);
BEGIN
  EOLINE := FALSE;
  IF LENGTH (L) > 0 THEN MyChar := L (.1.);
  IF LENGTH (L) > 1 THEN L := SUBSTR (L, 2)
     ELSE EOLINE := TRUE;
END;  (* Recv Char *)

%TITLE Procedure Write_State
(*==================================================================*)
(* WRITE_STATE - write the present state to the debug file          *)
(*==================================================================*)
procedure Write_State;
var
  mess : string(2);
begin
    CASE STATE OF
       S_I : mess := 'I ';
       S   : mess := 'S ';
       SF  : mess := 'SF';
       SD  : mess := 'SD';
       SZ  : mess := 'SZ';
       SB  : mess := 'SB';
       C   : mess := 'C ';
       A   : mess := 'A ';
       R   : mess := 'R ';
       RF  : mess := 'RF';
       RD  : mess := 'RD';
       OTHERWISE mess := '??'
    END ; (* CASE state *)
    WRITELN (DFILE, '(State = ' || mess || ')' )
end;
%TITLE Procedure SendPacket
(* ===============================================================  *)
(* SendPacket -This procedure sends the SENDMSG packet .            *)
(*          1. The COUNT sent includes SEQ,PACKETTYPE,and CHECKSUM  *)
(*             i.e. it is 3 larger than the DATACOUNT.              *)
(*          2. The COUNT and SEQ and CHECKSUM values are offset by  *)
(*             32 decimal (20hex) to make it a printable ASCII char.*)
(*          3. The CHECKSUM are calculated on the ASCII value of    *)
(*             the printable characters.                            *)
(*          4. All character sent must be converted to EBCDIC       *)
(*             which get translated back to ASCII by the hardware.  *)
(*             The DATA and PACKETTYPE are stored in this program   *)
(*             as EBCDIC. The other char are assumed ASCII.         *)
(* Assumptions:                                                     *)
(*       The following Global variables must be correctly set       *)
(*       before calling this procedure .                            *)
(*       1. OUTDATACOUNT - an integer-byte count of data characters.*)
(*       2. OUTSEQ    - an integer-byte count of sequence number.   *)
(*       3. OUTPACKETTYPE - an EBCDIC char  of type .               *)
(*       4. SENDMSG   - an EBCDIC array of data to be sent.         *)
(* ===============================================================  *)
PROCEDURE SendPacket;
VAR I,SUM, Len1, Len2, HCheck : INTEGER;
BEGIN
  IF Debug THEN BEGIN
     WRITE (DFILE, 'SEND PACKET :  ');
     Write_State
  END;
  Line := '';
  SUM := 0;
  CRC := 0;
  CHECKBYTES := 1;
  IF ( (OUTPACKETTYPE IN (.'X','F','Z','B','D','E'.) ) OR
       (INPACKETTYPE  IN (.'D','C','K','F','Z','B'.) ) ) THEN
     IF CHECKTYPE = '2' THEN CHECKBYTES := 2
        ELSE  IF CHECKTYPE = '3' THEN CHECKBYTES := 3;
  SendChar (Line, SOH);                                 (* SOH   *)
  OUTCOUNT := OUTDATACOUNT + 2 + CHECKBYTES;
  If (Long_Packet AND (OUTDATACOUNT > 90)) THEN
     IF OUTPACKETTYPE = 'D' THEN OUTCOUNT := 0;
  SendChar (Line, ASCIITOEBCDIC (.OUTCOUNT+32.));       (* COUNT *)
  SUM := SUM + OUTCOUNT + 32;
  CRCheck (OUTCOUNT + 32);
  SendChar (Line, ASCIITOEBCDIC (.OUTSEQ+32.));           (* SEQ   *)
  IF NOT GetFile THEN SeqChar := ASCIITOEBCDIC (.OUTSEQ+32.);
  SUM := SUM + OUTSEQ + 32;
  CRCheck (OUTSEQ + 32);
  SendChar (Line, OUTPACKETTYPE);                        (* TYPE  *)
  SUM := SUM + ORD (EBCDICTOASCII (.ORD(OUTPACKETTYPE).) );
  CRCheck ( ORD (EBCDICTOASCII (.ORD (OUTPACKETTYPE).) ));
  IF (Long_Packet AND (OUTDATACOUNT > 90)) THEN
     IF OUTPACKETTYPE = 'D' THEN BEGIN
        OUTCOUNT := OUTDATACOUNT + CHECKBYTES;
        Len1 := OUTCOUNT DIV 95;
        SendChar (Line, ASCIITOEBCDIC (.Len1+32.));      (* LENX1 *)
        SUM := SUM + Len1 + 32;
        CRCheck (Len1 + 32);

        Len2 := OUTCOUNT MOD 95;
        SendChar (Line, ASCIITOEBCDIC (.Len2+32.));      (* LENX2 *)
        SUM := SUM + Len2 + 32;
        CRCheck (Len2 + 32);

        HCheck := (SUM + (SUM AND 'C0'X) DIV '40'X ) AND '3F'X ;
        SendChar (Line, ASCIITOEBCDIC (.HCheck+32.));   (* HCHECK *)
        SUM := SUM + HCheck + 32;
        CRCheck (HCheck + 32);
     END;

  IF OUTDATACOUNT > 0 THEN
     FOR I := 1 TO OUTDATACOUNT DO
       WITH SENDMSG DO
       BEGIN                                          (* Send Data *)
         SendChar (Line, CHARS(.I.));
         SUM := SUM + ORD (EBCDICTOASCII (.BYTES(.I.).));
         CRCheck (ORD (EBCDICTOASCII (.BYTES(.I.).)))
       END;
  IF CHECKBYTES = 1 THEN
  BEGIN                                        (* One char checksum *)
    CHECKSUM := (SUM + (SUM AND 'C0'X) DIV '40'X ) AND '3F'X ;
    SendChar (Line, ASCIITOEBCDIC (.CHECKSUM+32.));
    SendChar (Line, '0D'XC)
  END
  ELSE IF CHECKBYTES = 2  THEN
  BEGIN                                        (* Two char checksum *)
    CHECKSUM := (SUM DIV '40'X)  AND '3F'X ;  (* BIT 11 - 6 *)
    SendChar (Line, ASCIITOEBCDIC (.CHECKSUM+32.));
    CHECKSUM := (SUM         )  AND '3F'X ;  (* BIT 0 - 5  *)
    SendChar (Line, ASCIITOEBCDIC (.CHECKSUM+32.));
    SendChar (Line, '0D'XC)
  END
  ELSE BEGIN                              (* CRC-CCITT  3 character *)
    SendChar (Line,ASCIITOEBCDIC(.((CRC DIV '1000'X) AND '0F'X) +32.));
    SendChar (Line,ASCIITOEBCDIC(.((CRC DIV '0040'X) AND '3F'X) +32.));
    SendChar (Line,ASCIITOEBCDIC(.((CRC           ) AND '3F'X) +32.));
    SendChar (Line, '0D'XC)
  END;
  IF Debug THEN WRITELN (DFILE, Line)
END;  (* SendPacket procedure  *)
%TITLE Function RecvPacket
(*==================================================================*)
(* RecvPacket -This Function returns TRUE if it successfully        *)
(*             recieved a packet and FALSE if it had an error.      *)
(*  Side Effects:                                                   *)
(*       The following global variables will be set.                *)
(*       1. INCOUNT - an integer value of the msg char count .      *)
(*       2. INSEQ - an integer value of the sequence count.         *)
(*       3. TYPE  - an EBCDIC character of message type(Y,N,D,F,etc)*)
(*       4. REPLYMSG - an EBCDIC array of the data sent.            *)
(*                                                                  *)
(*         a)  All characters are received as EBCDIC values and     *)
(*             must be converted back to ASCII before using.        *)
(*==================================================================*)
FUNCTION RecvPacket : BOOLEAN;
VAR
    I,SUM,RESENDS,
    LEN1, LEN2,
    HCheck, Chk1,
    Chk2, Chk3,
    InCh1,
    InCh2, InCh3  : INTEGER;
    INCHAR,SChar  : CHAR;
    Ext_Length    : BOOLEAN;
LABEL FINDSOH;

BEGIN
  IF Debug THEN BEGIN
     WRITE (DFILE, 'RECEIVE PACKET :  ');
     Write_State
  END;
  InPacket (Line);
  IF LENGTH (Line) > 0 THEN
     IF Line (.1.) <> SOH THEN Line := STR (SOH) || Line;
  IF Debug THEN WRITELN (DFILE, Line);
FINDSOH:
  RecvChar (Line, INCHAR);                           (* SOH *)
  IF EOLINE THEN
  BEGIN (* Null response *)
    RecvPacket := TRUE;
    INPACKETTYPE:='N';
    RETURN
  END;  (* Null response *)
  IF INCHAR <> SOH THEN GOTO FINDSOH;                (* no SOH *)
  SUM := 0;
  CRC := 0;
  Ext_Length := FALSE;

  RecvChar (Line, INCHAR);
  INCOUNT := ORD (EBCDICTOASCII (.ORD (INCHAR).));   (* COUNT *)
  SUM := INCOUNT;
  CRCheck (INCOUNT);
  INCOUNT := INCOUNT - 32; (* To absolute value *)
  IF INCOUNT = 0 THEN Ext_Length := TRUE;

  RecvChar (Line, INCHAR);
  INSEQ := ORD (EBCDICTOASCII (.ORD (INCHAR).));      (* SEQ   *)
  SChar   := LastSeq;
  LastSeq := SeqChar;
  SeqChar := INCHAR;
  SUM := SUM + INSEQ;
  CRCheck (INSEQ);
  INSEQ := INSEQ - 32;
  IF Debug THEN WRITELN (DFILE,'SeqChar = ', SeqChar,LastSeq);

  RecvChar (Line, INCHAR);
  INPACKETTYPE := INCHAR;                       (* TYPE  *)
  SUM := SUM + ORD (EBCDICTOASCII (.ORD (INCHAR).));
  CRCheck (ORD (EBCDICTOASCII (.ORD (INCHAR).)));

  IF Ext_Length THEN BEGIN
     RecvChar (Line, INCHAR);                   (* LENX1 *)
     LEN1 := ORD (EBCDICTOASCII (.ORD (INCHAR).));
     SUM := SUM + LEN1;
     CRCheck (LEN1);
     LEN1 := (LEN1 - 32) * 95;

     RecvChar (Line, INCHAR);                   (* LENX2 *)
     LEN2 := ORD (EBCDICTOASCII (.ORD (INCHAR).));
     SUM := SUM + LEN2;
     CRCheck (LEN2);
     LEN2 := LEN2 - 32;
     INCOUNT := LEN1 + LEN2;

     RecvChar (Line, INCHAR);                   (* HCHECK *)
     HCheck := ORD (EBCDICTOASCII (.ORD (INCHAR).));
     CHECKSUM := (SUM + (SUM AND 192) DIV 64 ) AND 63;
     IF HCheck <> CHECKSUM + 32 THEN BEGIN
       RecvPacket := FALSE;
       SeqChar := LastSeq;
       LastSeq := SChar;
       IF Debug THEN WRITELN (DFILE,'HChecksum error : ', CHECKSUM+32);
       RETURN
     END;
     SUM := SUM + HCheck;
     CRCheck (HCheck);
  END;

  CHECKBYTES := 1;
  IF NOT ( (INPACKETTYPE IN (.'S','G','I','C','R','K','N'.) ) OR
           (OUTPACKETTYPE = 'S') ) THEN
     IF CHECKTYPE = '2' THEN CHECKBYTES := 2  ELSE
        IF CHECKTYPE = '3' THEN CHECKBYTES := 3;
  INDATACOUNT := INCOUNT - 2 - CHECKBYTES;
  IF Ext_Length THEN INDATACOUNT := INCOUNT - CHECKBYTES;
  IF INDATACOUNT > 0 THEN
     FOR I := 1 TO INDATACOUNT DO
       WITH REPLYMSG DO
       BEGIN                                         (* Receive data *)
         RecvChar (Line, CHARS (.I.));
         SUM := SUM + ORD (EBCDICTOASCII (.BYTES (.I.).));
         CRCheck (ORD (EBCDICTOASCII (.BYTES (.I.).)) )
       END;

  RecvPacket := TRUE;               (* ASSUME OK UNLESS CHECK FAILS *)

  IF CHECKBYTES = 1 THEN
  BEGIN                                       (* One byte CHECKSUM *)
    CHECKSUM := (SUM + (SUM AND 192) DIV 64 ) AND 63;
    RecvChar (Line, INCHAR);
    IF ORD (EBCDICTOASCII (.ORD (INCHAR).)) <> CHECKSUM + 32
    THEN BEGIN
       RecvPacket := FALSE;
       SeqChar := LastSeq;
       LastSeq := SChar;
       IF Debug THEN WRITELN (DFILE, 'Checksum error : ', CHECKSUM+32)
    END
  END

  ELSE IF CHECKBYTES = 2  THEN
  BEGIN                                       (* TWO BYTE CHECKSUM  *)
    Chk1 := (SUM  DIV '40'X ) AND '3F'X;
    Chk2 := (SUM         ) AND '3F'X;
    RecvChar  (Line, INCHAR);
    InCh1 := ORD (EBCDICTOASCII (.ORD (INCHAR).));
    RecvChar (Line, INCHAR);
    InCh2 := ORD (EBCDICTOASCII (.ORD (INCHAR).));

    IF ((InCh1 <> Chk1 + 32) OR (InCh2 <> Chk2 + 32)) THEN BEGIN
       RecvPacket := FALSE;
       SeqChar := LastSeq;
       LastSeq := SChar;
       IF Debug THEN WRITELN (DFILE, 'Checksum-2 error : ', Chk1+32);
       IF Debug THEN WRITELN (DFILE, '                   ', Chk2+32)
    END
  END

  ELSE BEGIN                                   (* CRC-CCITT checksum*)
    (* First char is bits 16-12, second is bits 11-6 and   *)
    (* third is bits 5-0 *)
    RecvChar (Line, INCHAR);
    InCh1 := ORD (EBCDICTOASCII (.ORD (INCHAR).));
    RecvChar (Line, INCHAR);
    InCh2 := ORD (EBCDICTOASCII (.ORD (INCHAR).));
    INCHAR := '0D'XC;
    RecvChar (Line, INCHAR);
    InCh3 := ORD (EBCDICTOASCII (.ORD (INCHAR).));

    Chk1 :=  ((CRC DIV '1000'X) AND '0F'X) +32;
    Chk2 :=  ((CRC DIV '40'X) AND'3F'X)  +32;
    Chk3 :=   (CRC AND '3F'X) +32;

    IF ((InCh1 <> Chk1) OR (InCh2 <> Chk2) OR (InCh3 <> Chk3))
       THEN BEGIN
       RecvPacket := FALSE;
       SeqChar := LastSeq;
       LastSeq := SChar;
       IF Debug THEN BEGIN
          WRITELN (DFILE, 'Checksum-3 (CRC) error : ', Chk1);
          WRITELN (DFILE, '                         ', Chk2);
          WRITELN (DFILE, '                         ', Chk3)
       END
    END
  END
END;  (* RecvPacket procedure  *)
%TITLE Procedures ReSendit, SendACK & SendError
(*==================================================================*)
(* ReSendit -  This procedure RESENDS the packet if it gets a nak   *)
(*             It calls itself recursively upto the number of times *)
(*             specified in the intial parameter list.              *)
(* Side Effects - If it fails then the STATE in the message is set  *)
(*                to 'A' which means ABORT .                        *)
(*==================================================================*)
PROCEDURE ReSendit ( RETRIES : INTEGER );
BEGIN
  IF RETRIES > 0 THEN
  BEGIN                                  (* Try again *)
    SendPacket;
    IF RecvPacket THEN
       IF INPACKETTYPE = 'Y' THEN BEGIN
          IF NOT GetFile AND (LastSeq<>SeqChar)
                 THEN ReSendit (RETRIES-1)
          END
          ELSE IF INPACKETTYPE = 'N' THEN ReSendit(RETRIES-1)
             ELSE STATE := A
    ELSE STATE := A
  END
  ELSE STATE := A                 (* Retries failed - ABORT *)
END; (* ReSendit procedure  *)

(*--------------------------------------------------------------*)
(*  SendACK - Procedure will send an ACK or NAK                 *)
(*            depending on the value of the Boolean parameter   *)
(*            i.e.  ENDACK(TRUE)  sends an ACK packet           *)
(*                 SENDACK(FALSE) sends an NAK packet           *)
(*--------------------------------------------------------------*)
PROCEDURE SendACK (B : BOOLEAN);
BEGIN
  OUTDATACOUNT := 0;
  IF B THEN OUTSEQ := OUTSEQ + 1;
  IF OUTSEQ >= 64 THEN OUTSEQ := 0;
  IF B THEN OUTPACKETTYPE := 'Y'
       ELSE OUTPACKETTYPE := 'N';
  SendPacket
END;  (* Send ACK or NAK *)

(*--------------------------------------------------------------*)
(*  SendError - Sends an error packet, with a message passed    *)
(*              from the caller.                                *)
(*--------------------------------------------------------------*)
PROCEDURE SendError (ErrStr : LString);
BEGIN
  OUTDATACOUNT  := LENGTH (ErrStr);
  SENDMSG.CHARS := ErrStr;
  OUTSEQ := 0;
  OUTPACKETTYPE := 'E';
  SendPacket
END;  (* SendError *)
%TITLE Some Send_X_Packet routines
(*-----------------------------------------------------------*)
(* SendBPacket - send break packet to terminate transmission *)
(*-----------------------------------------------------------*)
PROCEDURE SendBPacket;
BEGIN
  OUTDATACOUNT  := 0 ;
  OUTSEQ        := OUTSEQ + 1 ;
  IF OUTSEQ >= 64 THEN OUTSEQ := 0 ;
  OUTPACKETTYPE := 'B' ;
  SendPacket;
  IF RecvPacket THEN (* It's ok *)
END; (* SendBPacket *)

(*-----------------------------------------------------------*)
(* SendZPacket - send EOF packet                             *)
(*-----------------------------------------------------------*)
PROCEDURE SendZPacket;
BEGIN
  OUTDATACOUNT  :=  0 ;
  OUTSEQ        := OUTSEQ + 1 ;
  IF OUTSEQ >= 64 THEN OUTSEQ := 0; ;
  OUTPACKETTYPE := 'Z' ;
  SendPacket;
  IF RecvPacket THEN (* Ok *)
END; (* SendZPacket *)

(*-----------------------------------------------------------*)
(* SendXPacket - send data header packet for terminal        *)
(*-----------------------------------------------------------*)
PROCEDURE SendXPacket (Head : LString);
BEGIN
  OUTDATACOUNT  := LENGTH (Head);
  OUTSEQ        := OUTSEQ + 1 ;
  IF OUTSEQ >= 64 THEN OUTSEQ := 0 ;
  OUTPACKETTYPE := 'X';
  SENDMSG.CHARS := Head;
  SendPacket;
  IF RecvPacket THEN
     IF INPACKETTYPE='Y' THEN (* It's ok *)
     ELSE IF INPACKETTYPE = 'N' THEN ReSendit (10)
END; (* SendXPacket *)

(*-----------------------------------------------------------*)
(* SendYPacket - send acknoledgement with data to micro      *)
(*-----------------------------------------------------------*)
PROCEDURE SendYPacket (Head : LString);
BEGIN
  OUTDATACOUNT  := LENGTH (Head);
  OUTPACKETTYPE := 'Y';
  SENDMSG.CHARS := Head;
  SendPacket
END; (* SendYPacket *)

(*-----------------------------------------------------------*)
(* SendDPacket - send data packet to micro                   *)
(*-----------------------------------------------------------*)
PROCEDURE SendDPacket (Head : LString; VAR Flag : BOOLEAN);
BEGIN
  OUTSEQ := OUTSEQ + 1;
  IF OUTSEQ >= 64 THEN OUTSEQ := 0;
  OUTDATACOUNT  := LENGTH (Head);
  OUTPACKETTYPE := 'D';
  SENDMSG.CHARS := Head;
  SendPacket;
  Flag := TRUE;
  IF RecvPacket THEN
     IF INPACKETTYPE='Y' THEN  (* nothing *)
     ELSE IF INPACKETTYPE='N' THEN ReSendit (10)
          ELSE Flag := FALSE
END; (* SendDPacket *)
%TITLE Procedures GetToken & ParmPacket
(* ===============================================================  *)
(* GetToken -  This procedure extracts a token from a string and    *)
(*             the function returns a 8 character token value.      *)
(*             the string is update with the portion that is left.  *)
(* ===============================================================  *)
FUNCTION GetToken ( VAR INSTRING : STRING(256)) : ALFA;
 VAR
    BP,BPM : INTEGER ; (* Blank Pointer *)

BEGIN
  IF LENGTH (INSTRING) < 1 THEN GetToken := '        '
  ELSE BEGIN
    BP := INDEX (INSTRING, ' ');
    IF BP = 0 THEN BP := LENGTH (INSTRING) + 1;
    BPM := MIN(BP,9);
    GetToken := DELETE (INSTRING, BPM);
    INSTRING := DELETE (INSTRING, 1, MIN (BP, LENGTH (INSTRING)))
  END
END; (* GetToken *)

(*=================================================================*)
(* ParmPacket - This procedure makes the PARAMETER PACKET.         *)
(*=================================================================*)
PROCEDURE ParmPacket;
VAR i, l1, l2 : BYTE;
BEGIN
  OUTDATACOUNT := 13;
  OUTSEQ       := 0;
  WITH SENDMSG DO
  BEGIN         (* Setup PARM packet *)
    (* The values  are tranformed by adding hex 20 to    *)
    (* the true value, making the value a printable char *)
    CHARS (.1.)  := ASCIITOEBCDIC (.94+32.);    (* Buffersize       *)
    CHARS (.2.)  := ASCIITOEBCDIC (.'28'X.);    (* Time out 8 sec   *)
    CHARS (.3.)  := ASCIITOEBCDIC (.'20'X.);    (* Num padchars=0   *)
    CHARS (.4.)  := ASCIITOEBCDIC (.'40'X.);    (* Pad char=blank   *)
    CHARS (.5.)  := ASCIITOEBCDIC (.ECHAR+32.); (* EOL char = CR    *)
    CHARS (.6.)  := CNTRL_QUOTE;                (* Quote character  *)
    CHARS (.7.)  := BIT8_QUOTE;                 (* Quote character  *)
    IF BIT8_QUOTE = '00'XC THEN CHARS (.7.) := 'Y';
    CHARS (.8.)  := CHECKTYPE;                  (* Check type       *)
    CHARS (.9.)  := REPEATCHAR;                 (* Repeat character *)
    IF REPEATCHAR = '00'XC THEN CHARS (.7.) := ' ';
    l1 := 2+8;                                  (* 2 = LONGP        *)
                                                (* 8 = ATTRIBUTE    *)
    CHARS (.10.) := ASCIITOEBCDIC (.l1+32.);    (* CAPAS character  *)
    CHARS (.11.) := ASCIITOEBCDIC (.'20'X.);    (* Window size = 0  *)
    IF Long_Packet THEN l1 := PSIZE DIV 95 ELSE l1 := 0;
    CHARS (.12.) := ASCIITOEBCDIC (.l1+32.);    (* Ext.packet len1  *)
    IF Long_Packet THEN l2 := PSIZE MOD 95 ELSE l2 := 94;
    CHARS (.13.) := ASCIITOEBCDIC (.l2+32.);    (* Ext.packet len2  *)
                                                (* DEF:0*95+94= 94  *)
  END
END;  (*  parameters *)
%TITLE Procedure FileToPacket
(*==================================================================*)
(* FileToPacket - This procedure files in a DATA packet D or X type *)
(*                with data from the file SFILE.                    *)
(*==================================================================*)
PROCEDURE FileToPacket;
BEGIN
  OUTDATACOUNT := 0;
  OUTSEQ       := OUTSEQ + 1;
  IF OUTSEQ >= 64 THEN OUTSEQ := 0;
  WHILE (OUTDATACOUNT < PSIZE-3-4-4) AND (NOT EOF (SFILE)) DO
  BEGIN (* Read a record *)
    OUTDATACOUNT := OUTDATACOUNT + 1 ;
    READ (SFILE, SENDMSG.CHARS (.OUTDATACOUNT.));
    WITH SENDMSG DO
       IF TEXTMODE THEN
       BEGIN  (* translate file *)
         (* The following double translation is used to   *)
         (* filter out meaningless EBCDIC characters into *)
         (* something more consistent.                    *)
         IF BYTES (.OUTDATACOUNT.) <> 0 THEN
            CHARS (.OUTDATACOUNT.) :=
            EBCDICTOASCII (.BYTES (.OUTDATACOUNT.).);
         IF BYTES (.OUTDATACOUNT.) > 127 THEN
         BEGIN                           (* 8th bit quote this char *)
           BYTES (.OUTDATACOUNT+1.) := BYTES (.OUTDATACOUNT.) - 128;
           CHARS (.OUTDATACOUNT.)   := BIT8_QUOTE;
           OUTDATACOUNT := OUTDATACOUNT + 1
         END;
         IF BYTES (.OUTDATACOUNT.) < 32 THEN
         BEGIN                               (* control quoting *)
            BYTES (.OUTDATACOUNT+1.) :=
            BYTES (.OUTDATACOUNT.) + 64;
            CHARS (.OUTDATACOUNT.) := CNTRL_QUOTE;
            OUTDATACOUNT := OUTDATACOUNT + 1
         END;
         IF BYTES (.OUTDATACOUNT.) = '7F'X THEN
         BEGIN                                 (* <DEL> quoting *)
            CHARS (.OUTDATACOUNT+1.) := '3F'XC;
            CHARS (.OUTDATACOUNT.)   := CNTRL_QUOTE;
            OUTDATACOUNT := OUTDATACOUNT + 1
         END;
         IF BYTES (.OUTDATACOUNT.) = '7E'X THEN
         BEGIN                                 (* Repeat quoting *)
            CHARS (.OUTDATACOUNT+1.) := '7E'XC;
            CHARS (.OUTDATACOUNT.)   := CNTRL_QUOTE;
            OUTDATACOUNT := OUTDATACOUNT + 1
         END;
         IF BYTES (.OUTDATACOUNT.) <> 0 THEN
            CHARS (.OUTDATACOUNT.) :=
                  ASCIITOEBCDIC (.BYTES (.OUTDATACOUNT.).);
         IF (CHARS (.OUTDATACOUNT.) = CNTRL_QUOTE) OR
            (CHARS (.OUTDATACOUNT.) = BIT8_QUOTE) THEN
         BEGIN                                (* Quote the quote *)
            CHARS (.OUTDATACOUNT+1.) := CHARS (.OUTDATACOUNT.);
            CHARS (.OUTDATACOUNT.)   := CNTRL_QUOTE;
            OUTDATACOUNT := OUTDATACOUNT + 1
         END
       END
       ELSE BEGIN (* Untranslated file *)
         (* Untranslated file means the file is stored as  *)
         (* 8 bit ASCII. However it must be translated into*)
         (* EBCDIC so that the comten software will trans- *)
         (* late it back into ASCII.                       *)
         IF BYTES (.OUTDATACOUNT.) >= 128 THEN
            IF BIT8_QUOTE = '00'XC THEN        (* No bit8 quoting *)
                                          (* Just drop the 8th bit  *)
               BYTES (.OUTDATACOUNT.) := BYTES (.OUTDATACOUNT.) - 128
            ELSE BEGIN                         (* BIT8 QUOTING *)
               BYTES (.OUTDATACOUNT+1.) := BYTES (.OUTDATACOUNT.)-128;
               CHARS (.OUTDATACOUNT.)   := BIT8_QUOTE;
               OUTDATACOUNT := OUTDATACOUNT + 1
            END;
         IF BYTES (.OUTDATACOUNT.) < 32 THEN
         BEGIN                                   (* CONTROL QUOTING *)
            BYTES (.OUTDATACOUNT+1.) := BYTES (.OUTDATACOUNT.) + 64;
            CHARS (.OUTDATACOUNT.)   := CNTRL_QUOTE;
            OUTDATACOUNT := OUTDATACOUNT + 1
         END;
         IF BYTES (.OUTDATACOUNT.) = '7F'X THEN
         BEGIN                                     (* <DEL> quoting *)
            CHARS (.OUTDATACOUNT+1.) := '3F'XC;
            CHARS (.OUTDATACOUNT.)   := CNTRL_QUOTE;
            OUTDATACOUNT := OUTDATACOUNT + 1
         END;
         IF BYTES (.OUTDATACOUNT.) = '7E'X THEN
         BEGIN                                     (* Repeat quoting *)
            CHARS (.OUTDATACOUNT+1.) := '7E'XC;
            CHARS (.OUTDATACOUNT.)   := CNTRL_QUOTE;
            OUTDATACOUNT := OUTDATACOUNT + 1
         END;
         IF BYTES (.OUTDATACOUNT.) <> 0 THEN
            CHARS (.OUTDATACOUNT.) :=
                  ASCIITOEBCDIC (.BYTES (.OUTDATACOUNT.).);
         IF (CHARS (.OUTDATACOUNT.) = CNTRL_QUOTE) OR
            (CHARS (.OUTDATACOUNT.) = BIT8_QUOTE) THEN
         BEGIN                                  (* Quote the quote *)
            CHARS (.OUTDATACOUNT+1.) := CHARS (.OUTDATACOUNT.);
            CHARS (.OUTDATACOUNT.)   := CNTRL_QUOTE;
            OUTDATACOUNT := OUTDATACOUNT + 1
         END
       END;
       IF EOLN (SFILE) THEN BEGIN             (* Send CR, LF *)
         READLN (SFILE);
       (*IF TEXTMODE AND (OUTDATACOUNT>1) THEN              *)
            (* Delete trailing blanks *)
       (*WHILE (SENDMSG.CHARS (.OUTDATACOUNT.) = ' ') AND   *)
       (*      (OUTDATACOUNT > 1) DO                        *)
       (*  OUTDATACOUNT := OUTDATACOUNT - 1;                *)
         IF TEXTMODE THEN BEGIN              (* Only for text files *)
            OUTDATACOUNT := OUTDATACOUNT + 1;
            SENDMSG.CHARS (.OUTDATACOUNT.) := CNTRL_QUOTE;
            OUTDATACOUNT := OUTDATACOUNT + 1;
            SENDMSG.CHARS (.OUTDATACOUNT.):='M'; (* Carriage Ret *)
            OUTDATACOUNT := OUTDATACOUNT + 1;
            SENDMSG.CHARS (.OUTDATACOUNT.) := CNTRL_QUOTE;
            OUTDATACOUNT := OUTDATACOUNT + 1;
            SENDMSG.CHARS (.OUTDATACOUNT.) := 'J'  (* Line Feed *)
         END
       END
   END
END; (* FILE TO PACKET *)

%TITLE Procedure CheckParms
(********************************************************************)
(* CheckParms- This routine checks the parameters received from     *)
(*             the micro KERMIT.                                    *)
(********************************************************************)
PROCEDURE CheckParms;
VAR i : INTEGER;
BEGIN
 IF INDEX (SPECTABLE, STR (CNTRL_QUOTE)) = 0 THEN CNTRL_QUOTE := '#';
 IF INDEX ('123', STR (CHECKTYPE))       = 0 THEN CHECKTYPE   := '1';
 IF INDEX (SPECTABLE, STR (BIT8_QUOTE))  = 0 THEN BIT8_QUOTE  := '&';
 IF BIT8_QUOTE = 'Y'  THEN BIT8_QUOTE  := '&';
 IF BIT8_QUOTE = 'N'  THEN BIT8_QUOTE  := '00'XC;
 IF INDEX (SPECTABLE, STR (REPEATCHAR))  = 0 THEN REPEATCHAR  := '~';
 i := CAPAS DIV 2;
 IF ODD (i) THEN Long_Packet := TRUE ELSE Long_Packet := FALSE;
 IF (NOT Long_Packet AND (PSIZE > 94)) THEN PSIZE := 94;
 IF PSIZE > 1000 THEN PSIZE := 1000;
 IF PSIZE < 26 THEN PSIZE := 94;
 (* IF PSIZE > 256 THEN CHECKTYPE := '3'; *)
 i := CAPAS DIV 8;
 IF ODD (i) THEN Handle_Attribute := TRUE
            ELSE Handle_Attribute := FALSE
END; (* CheckParms *)

%TITLE Procedure SendFile
(********************************************************************)
(* SendFile  - This routine handles the sending of a file to        *)
(*             the micro computer.                                  *)
(*             If the parameter string is blank it gets the file-   *)
(*             name from the users.                                 *)
(*             If it is non blank it assumes the file name is in    *)
(*             the parameter string, which was obtained by the      *)
(*             remote RECEIVE file command.                         *)
(********************************************************************)
PROCEDURE SendFile (FNAME : LString; XHeader : BOOLEAN);

LABEL LOOP1;

VAR
  Member      : STRING(8);
  AsName,
  KermName    : LString;
  Closed,
  SENDING,EOL : BOOLEAN;
  i, j, Ix,
  RETRIES     : INTEGER;
  DUMMY,
  B8Quote     : CHAR;

BEGIN
  IF FNAME = ' ' THEN  (* Get file name *)
     REPEAT
       Prompt ('Enter name of sendfile>', FNAME)
     UNTIL FNAME <> ' ';
  FNAME := LTRIM (FNAME);
  FNAME := TRIM (FNAME);
  AsName := ' ';
  IF INDEX(FNAME,' ') > 1 THEN BEGIN
     i := INDEX(FNAME,' ');
     AsName := SUBSTR (FNAME, i+1);
     FNAME  := SUBSTR (FNAME, 1, i-1);
     AsName := LTRIM  (Upper (AsName));
     IF INDEX(AsName,'AS ') > 0 THEN BEGIN
        i := INDEX  (AsName,'AS ') + 3;
        AsName := SUBSTR(AsName, i)
     END;
     IF Debug THEN WRITELN (DFile, 'AsName3 = ' || AsName);
  END;
  Wildcard_Search (FNAME);
  IF FileCount > 0 THEN FNAME := FileList (.1.)
  ELSE BEGIN (* No filename meets search criteria *)
    IF Remote THEN SendError ('No filename meets search criteria')
       ELSE WRITELN ('No filename meets search criteria');
       RETURN   (* Return to calling routine *)
  END;
  FNAME := TRIM (FNAME);
  CheckDsn (FNAME, DsnDisp);
  CASE DsnDisp OF
    BADNAME: BEGIN  (* Invalid TSO filename specified *)
               IF Remote THEN
                  SendError ('Bad filename ' || FNAME)
               ELSE WRITELN ('Bad filename ' || FNAME);
               RETURN   (* Return to calling routine *)
             END;
    NOMEM :  BEGIN  (* No member for PDS specified *)
               IF Remote THEN
                  SendError ('No member for PDS specified')
               ELSE WRITELN ('No member for PDS specified');
               RETURN   (* Return to calling routine *)
             END;
    NOACC :  BEGIN  (* No access to dataset *)
               IF Remote THEN
                  SendError ('No access to requested file')
               ELSE WRITELN ('No access to requested file');
               RETURN   (* Return to calling routine *)
             END;
    NEW,
    NEWMEM : BEGIN  (* Data set or member not found *)
               IF Remote THEN
                  SendError ('Data set ' || FNAME || ' not found')
               ELSE WRITELN ('Data set ', FNAME, ' not found !');
               RETURN   (* Return to calling routine *)
             END;
    OTHERWISE (* ok, data set exists *)
  END;
  IF AsName = ' ' THEN Extract (FNAME, KermName)
     ELSE KermName := AsName;
  IF Debug THEN WRITELN (DFILE, ' Sending file ', FNAME);
  IF NOT Remote THEN BEGIN
     WRITELN ('ready to SEND file  - Put Micro in receive mode. ');
     Waiting (Delay)
  END;
  Ix := 1;
  IF XHeader THEN BEGIN                 (* Type file in remote mode *)
     STATE := SD;
     TSOCommand := 'ALLOC F(SFILE) DA(' || FNAME || ') SHR REUSE';
     TSOService (TSOCommand, RC);
     IF Debug THEN WRITELN (DFILE, TSOCommand, ' RC = ', RC);
     RESET (SFILE)
  END ELSE STATE := S;
  GETREPLY := FALSE;
  SENDING := TRUE;
  WHILE SENDING DO BEGIN (* Send files *)
    IF GETREPLY THEN
       IF RecvPacket THEN
          IF (INPACKETTYPE = 'Y') AND (SeqChar=LastSeq) THEN {}
             ELSE IF (INPACKETTYPE = 'Y') AND (SeqChar<>LastSeq)
                  THEN ReSendit (10)
                ELSE IF INPACKETTYPE = 'N' THEN ReSendit(10)
                   ELSE IF INPACKETTYPE = 'R' THEN STATE := S
                      ELSE STATE := A
                         ELSE  ReSendit(10);
  GETREPLY := TRUE;
  IF (INPACKETTYPE = 'Y') AND (INDATACOUNT > 0) THEN
     IF REPLYMSG.CHARS (.1.) = 'X' THEN STATE := SZ
        ELSE IF REPLYMSG.CHARS (.1.) = 'Z' THEN STATE := SZ;

  CASE STATE OF
    S :  BEGIN                                  (* Send INIT packit *)
           OUTPACKETTYPE := 'S';
           ParmPacket;
           SendPacket;
           STATE := SF
         END;

    SF:  BEGIN                                  (* Send file header *)
           IF INDATACOUNT > 1 THEN
           BEGIN                      (* Get init parameters *)
             IF INDATACOUNT >= 1 THEN
                PSIZE :=
                ORD (EBCDICTOASCII (.REPLYMSG.BYTES (.1.).)) - 32;
             IF INDATACOUNT >= 5 THEN
                ECHAR :=
                ORD (EBCDICTOASCII (.REPLYMSG.BYTES (.5.).)) - 32;
             IF INDATACOUNT >= 6 THEN
                CNTRL_QUOTE := REPLYMSG.CHARS (.6.);
             IF INDATACOUNT >= 7 THEN BEGIN
                B8Quote := REPLYMSG.CHARS (.7.);
                IF B8Quote = 'Y' THEN BIT8_QUOTE := '&';
                IF NOT (B8Quote IN (.'Y', 'N'.)) THEN
                   BIT8_QUOTE := B8Quote
             END;
             IF INDATACOUNT >= 8 THEN
                CHECKTYPE  := REPLYMSG.CHARS (.8.)
             ELSE CHECKTYPE  := '1';
             IF INDATACOUNT >= 9 THEN
                REPEATCHAR := REPLYMSG.CHARS (.9.)
             ELSE REPEATCHAR := '~';
             IF INDATACOUNT >= 10 THEN
                CAPAS      :=
                   ORD (EBCDICTOASCII (.REPLYMSG.BYTES (.10.).)) - 32
                ELSE CAPAS := 0;
             IF INDATACOUNT >= 13 THEN BEGIN
                PSIZE :=
                   ORD (EBCDICTOASCII (.REPLYMSG.BYTES (.12.).)) - 32;
                PSIZE := PSIZE * 95 +
                   ORD (EBCDICTOASCII (.REPLYMSG.BYTES (.13.).)) - 32
             END;
             CheckParms
           END;
           OUTSEQ        := OUTSEQ + 1;
           IF OUTSEQ >= 64 THEN OUTSEQ := 0;
           OUTPACKETTYPE := 'F';
           SENDMSG.CHARS := KermName;
           OUTDATACOUNT  := LENGTH (KermName);
           SendPacket;
           TSOCommand := 'ALLOC F(SFILE) DA(' || FNAME ||
                         ') SHR REUSE';
           TSOService (TSOCommand, RC);
           IF Debug THEN WRITELN (DFILE, TSOCommand, ' RC = ', RC);
           Closed := FALSE;
           RESET (SFILE);
           IF Handle_Attribute THEN               (* Send attributes *)
              IF RecvPacket THEN
                 IF INPACKETTYPE = 'Y' THEN BEGIN
                    OUTSEQ        := OUTSEQ + 1;
                    IF OUTSEQ >= 64 THEN OUTSEQ := 0;
                    OUTPACKETTYPE := 'A';
                    SENDMSG.CHARS := '."I2'; (*IBM/370 with MVS/TSO*)
                    OUTDATACOUNT  := 4;
                    SendPacket
                  END;
           STATE := SD
         END;

    SD:  BEGIN                                         (* Send data *)
           OUTPACKETTYPE := 'D';
           FileToPacket;
           SendPacket;
           IF EOF (SFILE) THEN STATE := SZ
         END;

    SZ:  BEGIN
           OUTDATACOUNT  := 0;
           OUTSEQ        := OUTSEQ + 1;
           IF OUTSEQ >= 64 THEN OUTSEQ := 0;
           OUTPACKETTYPE := 'Z';
           SendPacket;
    LOOP1: IF Ix >= FileCount THEN STATE := SB
           ELSE BEGIN
              IF NOT Closed THEN BEGIN
                 CLOSE (SFILE);
                 TSOService ('FREE F(SFILE)', RC);
                 Closed := TRUE
              END;
              Ix := Ix + 1;
              FNAME := FileList (.Ix.);
              CheckDsn (FNAME, DsnDisp);
              CASE DsnDisp OF
                 BADNAME: BEGIN  (* Invalid TSO filename specified *)
                            IF DEBUG THEN WRITELN
                               (DFILE, 'Bad filename ' || FNAME);
                            GOTO LOOP1
                          END;
                 NOMEM :  BEGIN  (* No member specified *)
                            IF DEBUG THEN WRITELN
                               (DFILE,'No member for PDS specified');
                            GOTO LOOP1
                          END;
                 NOACC :  BEGIN  (* No access to dataset *)
                            IF DEBUG THEN WRITELN
                               (DFILE,'No access to requested file');
                            GOTO LOOP1
                          END;
                 NEW,
                 NEWMEM : BEGIN  (* Data set or member not found *)
                            IF Debug THEN WRITELN (DFILE,
                                 'Data set ' || FNAME || ' not found');
                            GOTO LOOP1
                          END;
                 OTHERWISE (* ok, data set exists *)
              END;
              Extract (FNAME, KermName);
              STATE := SF
           END;
         END;

    SB:  BEGIN                                    (* Last file sent *)
           OUTDATACOUNT  := 0;
           OUTSEQ        := OUTSEQ + 1;
           IF OUTSEQ >= 64 THEN OUTSEQ := 0;
           OUTPACKETTYPE := 'B';
           SendPacket;
           STATE := C
         END;

     C:  BEGIN                                 (* Completed Sending *)
           CLOSE (SFILE);
           TSOService ('FREE F(SFILE)', RC);
           SENDING := FALSE
         END;

     A:  BEGIN                                    (* Abort Sending *)
           CLOSE (SFILE);
           TSOService ('FREE F(SFILE)', RC);
           ABORT   := BADSF;
           SENDING := FALSE;
           SendError ('Send file aborted')
         END
     END  (* CASE of STATE *)
   END  (* Send files *)
END; (* SendFile procedure *)
%TITLE Procedure RecvFile
(* **************************************************************** *)
(* RecvFile  - This routine handles the Receiving of a file from    *)
(*             the micro computer.                                  *)
(*                                                                  *)
(* Note : whenever a CR,LF pair is received it assumes it is the    *)
(*        an EOLN indicator and are not stored in the file.         *)
(*        However if we get two CR,LF in a row we can not write     *)
(*        an empty record so we must store the next CR,LF in the    *)
(*        next record .                                             *)
(* **************************************************************** *)
PROCEDURE RecvFile;

VAR
  BIT8       : BYTE;
  B8Quote,
  Dummy      : CHAR;
  IN_Attr,
  FILEWANTED,
  OldFname   : LString;
  REP, K,
  RETRIES,IX : INTEGER;
  CRFLAG,
  CRLFFLAG   : BOOLEAN;
  TITLE      : STRING (80);
  RFILE      : TEXT;                               (* RECEIVE file *)

  (*-------------------------------------------------------------*)
  (*  SendNAK - Procedure of RECVFILE, will check the number of  *)
  (*            RETRIES , if it is greater than 0 it will send a *)
  (*            call SENDACK(FALSE) which send a NAK packet and  *)
  (*            decrements the RETRIES by 1.                     *)
  (*  Side Effect - RETRIES is decremented by 1.                 *)
  (*                STATE is set to A if no more retries.        *)
  (*-------------------------------------------------------------*)
  PROCEDURE SendNAK;
  BEGIN
    IF RETRIES > 0 THEN
    BEGIN
      SendACK (FALSE);
      RETRIES := RETRIES - 1
    END
    ELSE STATE := A
  END; (* SEND ACK or NAK *)

  (*---------------------------------------------------------------*)
  (*  AllocFile - Procedure of RECVFILE, will allocate a file for  *)
  (*              receiving function.                              *)
  (*---------------------------------------------------------------*)
  PROCEDURE AllocFile (OutFile : LSTRING);
  VAR
    DsnDCB  : STRING(40);
  BEGIN
    IF NOT TEXTMODE THEN DsnDCB := DCB_Bin
       ELSE IF FB THEN DsnDCB := DCB_Fix
          ELSE DsnDCB := DCB_Var;
    TSOCommand := 'ALLOC F(RFILE) DA(' || OutFile || ') ';
    CASE DsnDisp OF
       NEW    : BEGIN
                  TSOCommand :=
                     TSOCommand || 'NEW TR SP(5,5) ' || DsnDCB;
                  IF INDEX (OutFile, '(') > 0 THEN
                     TSOCommand := TSOCommand || ' DIR(5)';
                END;
       NEWMEM,
       SHARE  : TSOCommand := TSOCommand || 'SHR REUSE';
       OLD,
       OLDMEM : TSOCommand := TSOCommand || 'OLD REUSE';
       MODIFY : TSOCommand := TSOCommand || 'MOD REUSE';
    END;
    TSOService (TSOCommand, RC);
    IF Debug THEN WRITELN (DFILE, TSOCommand, ' => RetCode = ', RC);
  END; (* Allocate File for Receiving *)

  (*---------------------------------------------------------------*)
  (*  DecodeAttr - Decode incoming attribute fields.               *)
  (*---------------------------------------------------------------*)
  PROCEDURE DecodeAttr (AttrStr : LSTRING);
  VAR
    K,
    Len : INTEGER;
    Ch1 : CHAR;
    Attribute : STRING(94);
  BEGIN
    WHILE LENGTH (AttrStr) > 1 DO BEGIN
      Ch1       := AttrStr (.1.);
      Len       := ORD (EBCDICTOASCII (. ORD (AttrStr(.2.)).))-32;
      Attribute := SUBSTR (AttrStr, 3, Len);
      AttrStr   := DELETE (AttrStr, 1, Len+2);
      IF DEBUG THEN WRITELN (DFILE, 'Attribute: ', Ch1,' ', Attribute)
    END;
  END; (* DecodeAttr *)

BEGIN
  GetFile := TRUE;
  IF NOT Remote THEN
    IF LENGTH (INPUTSTRING) > 0 THEN BEGIN
       FILEWANTED := INPUTSTRING;
       IF INDEX (FILEWANTED, '*') > 0 THEN BEGIN
          WRITELN ('Wildcards not allowed, yet');
          RETURN
       END;
       CheckDsn  (FILEWANTED, DsnDisp);
       IF DsnDisp = ERROR THEN BEGIN
          WRITELN ('An error occurred while reading DS information');
          WRITELN ('Please turn DEBUG option ON, and retry operation');
          RETURN
       END;
       AllocFile (FILEWANTED);
       WRITELN (' RECEIVE mode - Issue a SEND command from micro. ')
    END;
  IF Remote THEN BEGIN OUTSEQ := 0; SendNAK END;
  STATE := R;
  RECEIVING := TRUE;
  RETRIES := 10;            (* Up to 10 retries allowed. *)

  WHILE RECEIVING DO
  CASE STATE OF
    R : BEGIN                             (* Initial Receive State  *)
          IF (NOT RecvPacket) OR (INPACKETTYPE='N') THEN SendNAK
          ELSE (* Get a packet *)
            IF INPACKETTYPE = 'S' THEN
            BEGIN  (* Get Init parameters *)
              IF INDATACOUNT >= 1 THEN
                 PSIZE := ORD(EBCDICTOASCII(.REPLYMSG.BYTES(.1.).))-32;
              IF INDATACOUNT >= 5 THEN
                 ECHAR := ORD(EBCDICTOASCII(.REPLYMSG.BYTES(.5.).))-32;
              IF INDATACOUNT >= 6 THEN
                 CNTRL_QUOTE := REPLYMSG.CHARS (.6.);
              IF INDATACOUNT >= 7 THEN BEGIN
                 B8Quote := REPLYMSG.CHARS (.7.);
                 IF B8Quote = 'Y' THEN BIT8_QUOTE := '&';
                 IF NOT (B8Quote IN (.'Y', 'N'.)) THEN
                    BIT8_QUOTE := B8Quote
              END;
              IF INDATACOUNT >= 8 THEN
                 CHECKTYPE  := REPLYMSG.CHARS (.8.)
              ELSE CHECKTYPE  := '1';
              IF INDATACOUNT >= 9 THEN
                 REPEATCHAR := REPLYMSG.CHARS(.9.)
              ELSE REPEATCHAR := '~';
              IF INDATACOUNT >= 10 THEN
                 CAPAS      :=
                   ORD (EBCDICTOASCII (.REPLYMSG.BYTES (.10.).)) - 32
                 ELSE CAPAS := 0;
              IF INDATACOUNT >= 13 THEN BEGIN
                 PSIZE :=
                   ORD (EBCDICTOASCII (.REPLYMSG.BYTES (.12.).)) - 32;
                 PSIZE := PSIZE * 95 +
                   ORD (EBCDICTOASCII (.REPLYMSG.BYTES (.13.).)) - 32
              END;
              CheckParms;
              OUTPACKETTYPE := 'Y';
              ParmPacket;
              SendPacket;
              STATE := RF
            END
            ELSE BEGIN (* Not init packet *)
              STATE := A;   (* ABORT if not INIT packet *)
              ABORT := NOT_S
            END
        END ; (* Initial Receive State  *)

    RF: IF (NOT RecvPacket) OR (INPACKETTYPE='N') THEN SendNAK
        ELSE (* Get a packet *)
          IF INPACKETTYPE = 'S' THEN STATE:=R
          ELSE IF INPACKETTYPE = 'Z' THEN SendACK (TRUE)
            ELSE IF INPACKETTYPE = 'B' THEN STATE:=C
               ELSE IF INPACKETTYPE = 'F' THEN
                  BEGIN                          (* Got file header *)
                    FILEWANTED :=
                      SUBSTR (STR (REPLYMSG.CHARS), 1, INDATACOUNT);
                    IF INDEX (FILEWANTED, '*') > 0 THEN BEGIN
                       SendError ('No wildcards allowed, yet');
                       RETURN
                    END;
                    IX := LENGTH (FILEWANTED);
                    IF FILEWANTED (.IX.) = '.' THEN
                       FILEWANTED := SUBSTR (FILEWANTED, 1, IX-1);
                    IF Remote THEN BEGIN
                       OldFname := FILEWANTED;
                       CheckDsn (FILEWANTED, DsnDisp);
                       IF DsnDisp = ERROR THEN STATE := A
                          ELSE AllocFile (FILEWANTED)
                    END;
                    IF DsnDisp <> ERROR THEN BEGIN
                       REWRITE (RFILE);
                       CRFLAG := FALSE;
                       CRLFFLAG := FALSE;
                       STATE := RD;
                       SendACK (TRUE)
                    END
                  END
                  ELSE BEGIN (* Not S,F,B,Z packet *)
                    (* ABORT if not a S,F,B,Z type packet *)
                    STATE := A;
                    ABORT := NOT_SFBZ
                  END;

    RD: IF (NOT RecvPacket) OR (INPACKETTYPE='N') THEN SendNAK
        ELSE (* Got a good packet *)
           IF INPACKETTYPE = 'A' THEN
              BEGIN                              (* Got attributes  *)
                 IN_Attr :=
                    SUBSTR (STR (REPLYMSG.CHARS), 1, INDATACOUNT);
                 DecodeAttr (IN_Attr);
                 SendACK (TRUE)
              END
           ELSE IF INPACKETTYPE = 'D' THEN          (* Receive data *)
             IF SeqChar = LastSeq THEN BEGIN         (* Drop packet *)
                OUTSEQ := OUTSEQ - 1;
                RETRIES := 10;               (* Reset RETRIES count *)
                SendACK (TRUE)
             END ELSE BEGIN                     (* Correct sequence *)
             RETRIES := 10;                  (* Reset RETRIES count *)
             I := 1;
             REP := 1;
             WHILE I <= INDATACOUNT DO
                WITH REPLYMSG DO
                  IF TEXTMODE THEN BEGIN       (* SCAN EBCDIC data *)
                    IF CHARS (.I.) = REPEATCHAR THEN
                    BEGIN                       (* Repeat character *)
                      REP := ORD (EBCDICTOASCII (.BYTES (.I+1.).))-32;
                      I := I + 2
                    END;
                    IF CHARS (.I.) = BIT8_QUOTE THEN
                    BEGIN                        (* 8 bit character *)
                      I := I+1 ;
                      BIT8 := 128
                    END ELSE BIT8 := 0;
                    IF CHARS (.I.) = CNTRL_QUOTE THEN
                    BEGIN                      (* CONTROL character *)
                      I := I+1;
                      CHARS (.I.) := EBCDICTOASCII (.BYTES (.I.).);
                      IF CHARS (.I.) = '3F'XC THEN (* Make it a del *)
                         BYTES (.I.) := '7F'X
                      ELSE
                        IF BYTES(.I.) >= 64 THEN (* Make it a control *)
                           IF CHARS (.I.) <> '7E'XC THEN
                              BYTES (.I.) := BYTES (.I.) - 64;
                      IF BYTES (.I.) <> 0 THEN
                         CHARS (.I.) :=
                               ASCIITOEBCDIC (.BYTES (.I.) + BIT8.);
                    END ELSE
                      IF BIT8 <> 0 THEN BEGIN
                         CHARS (.I.) := EBCDICTOASCII (.BYTES (.I.).);
                         CHARS (.I.) :=
                               ASCIITOEBCDIC (.BYTES (.I.) + BIT8.)
                      END;
                    IF CRFLAG THEN BEGIN  (* previous char was a CR *)
                       CRFLAG := FALSE;
                       IF CHARS (.I.) = '25'XC THEN WRITELN (RFILE)
                       ELSE BEGIN
                         WRITE (RFILE, '0D'XC);
                         FOR K := 1 TO REP DO
                             WRITE  (RFILE, CHARS (.I.));
                         REP := 1
                       END
                    END ELSE
                       IF  CHARS (.I.) = '0D'XC THEN CRFLAG := TRUE
                       ELSE BEGIN                    (* not a CR *)
                          CRFLAG := FALSE;
                          FOR K := 1 TO REP DO
                            WRITE  (RFILE, CHARS (.I.));
                          REP := 1
                       END;
                    I := I + 1
                  END
                  ELSE BEGIN             (* Text mode is OFF *)
                    (* Revert back to ASCII data record *)
                    IF CHARS (.I.) = REPEATCHAR THEN
                    BEGIN                       (* Repeat character *)
                      REP := ORD (EBCDICTOASCII (.BYTES (.I+1.).))-32;
                      I := I + 2
                    END;
                    IF CHARS (.I.) = BIT8_QUOTE THEN
                    BEGIN                       (* 8TH BIT QUOTING  *)
                      I := I+1;
                      BIT8 := 128
                    END ELSE BIT8 := 0;
                    IF CHARS (.I.) = CNTRL_QUOTE THEN
                    BEGIN                      (* CONTROL character *)
                      I := I+1 ;
                      CHARS (.I.) := EBCDICTOASCII (.BYTES (.I.).);
                      IF CHARS (.I.) = '3F'XC THEN (* Make it a del *)
                         BYTES (.I.) := '7F'X
                        ELSE
                        IF BYTES(.I.) >= 64 THEN (* Make it a control *)
                           IF CHARS (.I.) <> '7E'XC THEN
                              BYTES (.I.) := BYTES (.I.) - 64;
                    END   (* CONTROL character *)
                    ELSE CHARS (.I.) := EBCDICTOASCII (.BYTES (.I.).);
                    BYTES (.I.) := BYTES (.I.) + BIT8;
                    FOR K := 1 TO REP DO
                        WRITE  (RFILE, CHARS (.I.));
                    REP := 1;
                    I := I + 1
                  END ;
           SendACK (TRUE)
         END
         ELSE IF INPACKETTYPE = 'F' THEN BEGIN       (* Send ACK *)
           OUTSEQ := OUTSEQ - 1;
           SendACK (TRUE)
         END
         ELSE IF INPACKETTYPE = 'Z' THEN
         BEGIN                              (* End of Receive File *)
           CLOSE (RFILE);
           TSOService ('FREE F(RFILE)', RC);
           STATE := RF;
           SendACK (TRUE)
         END
         ELSE BEGIN                             (* Not D,Z packet *)
           STATE := A;   (* ABORT - Type not D or Z, *)
           ABORT := NOT_DZ
         END;

     C:  BEGIN                               (* COMPLETED Receiving *)
           CLOSE (RFILE);
           TSOService ('FREE F(RFILE)', RC);
           SendACK (TRUE);
           RECEIVING := FALSE;
           GetFile   := FALSE
         END;

     A:  BEGIN                                  (* Abort Receiving *)
           CLOSE (RFILE);
           IF Incomplete_File THEN
              TSOService ('FREE F(RFILE)', RC)
           ELSE TSOService ('FREE F(RFILE) DELETE', RC);
           RECEIVING := FALSE;
           GetFile   := FALSE;
           SendError ('Receive file aborted')
         END
   END (* CASE of STATE *)
END;  (* RecvFile *)

%TITLE Procedure ShowIT
(******************************************************************)
(* ShowIT -    This routine handles the SHOW COMMAND.             *)
(******************************************************************)

PROCEDURE ShowIT;
BEGIN
  WRITELN ('------- Current Status -----------');
  WRITELN (' ');
  IF ScreenSize = 0 THEN
     WRITELN (' KERMIT currently running in line mode (ASCII). ')
  ELSE WRITELN (' KERMIT currently running in full-screen mode.');
  WRITE   (' Init file KERMIT.SETUP ... ');
  IF Init_File THEN WRITELN ('already loaded')
     ELSE WRITELN ('not specified');
  WRITELN (' Your PROFILE data set is KERMIT.PROFILE');
  WRITELN (' ');
  IF TEXTMODE THEN BEGIN
     WRITELN (' TEXT MODE   is ON  - ASCII/EBCDIC');
     IF FB THEN  WRITELN (' RECFM_INPUT is FB, LRECL is 80')
           ELSE  WRITELN (' RECFM_INPUT is VB, LRECL is 255')
  END ELSE BEGIN
     WRITELN (' TEXT MODE   is OFF' );
     WRITELN (' RECFM_INPUT is U, BLKSIZE is 1024')
  END;
  WRITELN ('                ');
  WRITE   (' PACKET SIZE is ', PSIZE:3);
  IF Long_Packet THEN  WRITELN (' (extended packets)')
                 ELSE  WRITELN (' (standard packets)');
  WRITELN (' EOL CHAR    is ', ECHAR:2,' decimal(ascii)');
  WRITELN (' SOH CHAR    is ', SCHAR:2,' decimal(ascii)');
  WRITELN (' CNTRL_QUOTE is ', CNTRL_QUOTE);
  WRITELN (' BIT8_QUOTE  is ', BIT8_QUOTE, ORD (BIT8_QUOTE));
  WRITELN (' CHECKTYPE   is ', CHECKTYPE);
  WRITELN (' REPEATCHAR  is ', REPEATCHAR, ORD(REPEATCHAR));
  WRITELN (' DELAY       is ', Delay:3:1, ' seconds');
  WRITE   (' DEBUG mode  is ');
  IF Debug THEN WRITELN ('ON') ELSE WRITELN ('OFF');
  WRITE   (' INCOMPLETE  is ');
  IF Incomplete_File THEN WRITELN ('KEEP') ELSE WRITELN ('DELETE');
  WRITELN (' ');
  IF STATE = C THEN WRITELN('Last File transferred completed OK. ');
  IF STATE = A THEN BEGIN (* ABORTED file transfer *)
     WRITE  ('Last File transfer Aborted while ');
     CASE ABORT OF
       BADSF   : WRITELN ('attempting to send file to micro.');
       NOT_S   : WRITELN ('waiting for Init Packet.');
       NOT_SFBZ: WRITELN ('waiting for File header packet.');
       NOT_DZ  : WRITELN ('waiting for a DATA  packet.');
       OTHERWISE WRITELN ('being completely confused ');
     END;   (* CASE ABORT *)
     WRITELN(' ')
  END (* ABORTED file transfer *)
END;  (* ShowIT procedure *)

%TITLE Procedure SetIT
(******************************************************************)
(* SetIT  -    This routine handles the SET COMMAND.              *)
(******************************************************************)

PROCEDURE SetIT;
VAR Answer : ALFA;
    Temp   : STRING (1);
    N1, N2 : INTEGER;

BEGIN
  COMMAND := GETTOKEN (INPUTSTRING);
  UPCASE (COMMAND);
  REQUEST := ' ' || TRIM (STR (COMMAND));
  CINDEX := INDEX (WHATTABLE, REQUEST) DIV 8 ;
  IF LENGTH (INPUTSTRING) = 0 THEN INPUTSTRING := '?';

  CASE WHATFLAGS (CINDEX) OF
    $TEXTMODE :                                   (* TEXT MODE FLAG *)
            IF INPUTSTRING(.1.) = '?' THEN
               WRITELN ('Enter ON for Textfiles, OFF for binary files')
            ELSE BEGIN
            SETTING := GETTOKEN (INPUTSTRING);
            UPCASE (SETTING);
               TEXTMODE := NOT (SETTING = 'OFF     ');
               IF TEXTMODE THEN WRITELN ('TEXT MODE is ON ')
                  ELSE WRITELN ('TEXT MODE is OFF');
            END;
    $RECFM :                                          (* RECFM  *)
            IF INPUTSTRING(.1.) = '?' THEN BEGIN
               WRITELN ('Enter FB for fixed record length, ');
               WRITELN ('   or VB for variable record length')
            END ELSE BEGIN
               SETTING := GETTOKEN (INPUTSTRING);
               UPCASE (SETTING);
                 IF SETTING = 'FB      ' THEN FB := TRUE
                    ELSE FB := FALSE;
                 IF FB THEN WRITELN ('INPUT RECFM is FB, LRECL is 80')
                    ELSE WRITELN ('INPUT RECFM is VB, LRECL is 255 ')
            END;
    $PACKETSIZE:                              (* SET PACKET SIZE *)
            IF INPUTSTRING(.1.) = '?' THEN
              WRITELN ('Enter number (range 26 .. 1000) as packetsize')
            ELSE BEGIN
               IF INPUTSTRING (.1.) = '-' THEN
                  INPUTSTRING := SUBSTR (INPUTSTRING, 2);
               READSTR (INPUTSTRING, PSIZE);
               IF (PSIZE > 1000) THEN BEGIN
                  WRITELN ('ERROR: Number too large. Will use 1000');
                  PSIZE := 1000
               END;
               IF (PSIZE < 26) THEN BEGIN
                  WRITELN ('ERROR: Number too small. Will use 94');
                  PSIZE := 94
               END;
               IF PSIZE > 94 THEN Long_Packet := TRUE
                             ELSE Long_Packet := FALSE;
            (* IF PSIZE > 256 THEN CHECKTYPE := '3'; *)
               WRITELN ('PACKET SIZE is ',PSIZE:4)
            END;
   $EOLCHAR :                               (* SET end of line char *)
            IF INPUTSTRING(.1.) = '?' THEN
               WRITELN ('Enter number (ascii) used as eol character')
            ELSE BEGIN
               IF INPUTSTRING (.1.) = '-' THEN
                  INPUTSTRING := SUBSTR (INPUTSTRING, 2);
               READSTR (INPUTSTRING, ECHAR);
               IF (ECHAR < 5) OR (ECHAR > 18) THEN ECHAR := 13 ;
               WRITELN ('EOLCHAR     is ', ECHAR, ' decimal(ascii)')
            END;
   $CNTRL_QUOTE:                             (* SET control quote *)
            IF INPUTSTRING(.1.) = '?' THEN
               WRITELN ('Enter character to be used as cntrl quote')
            ELSE BEGIN
               READSTR (INPUTSTRING, Temp);
               IF INDEX (SPECTABLE, Temp) > 0 THEN
                  CNTRL_QUOTE := Temp (.1.) ELSE CNTRL_QUOTE := '#';
               WRITELN ('CNTRL QUOTE is ', CNTRL_QUOTE)
            END;
   $BIT8_QUOTE:                                (* SET bit 8 quote *)
            IF INPUTSTRING(.1.) = '?' THEN
               WRITELN ('Enter character to be used as bit8 quote')
            ELSE BEGIN
               READSTR (INPUTSTRING, Temp);
               IF INDEX (SPECTABLE, Temp) > 0 THEN
                  BIT8_QUOTE := Temp (.1.) ELSE BIT8_QUOTE := '&';
               WRITELN ('BIT8_QUOTE  is ', BIT8_QUOTE)
            END;
   $CHECKTYPE :                                  (* SET CHECK TYPE  *)
            IF INPUTSTRING(.1.) = '?' THEN
               WRITELN ('Enter number (1,2 or 3) to select check type')
            ELSE BEGIN
               READSTR (INPUTSTRING, CHECKTYPE);
               IF INDEX ('123', STR (CHECKTYPE)) = 0 THEN
                  CHECKTYPE := '1';
               WRITELN ('CHECKTYPE   is ', CHECKTYPE )
            END;
   $DELAY :                                     (* SET DELAY FACTOR *)
            IF INPUTSTRING(.1.) = '?' THEN
               WRITELN ('Enter send wait-time in seconds (2 .. 30)')
            ELSE BEGIN
               READSTR (INPUTSTRING, Delay);
               IF (Delay < 2) OR (Delay > 30) THEN Delay := 6;
               WRITELN ('Delay now set to ', Delay:3:1, ' seconds')
            END;
   $DEBUG :                                     (* SET DEBUG option *)
            IF INPUTSTRING(.1.) = '?' THEN BEGIN
               WRITELN ('Enter ON to log transactions, or');
               WRITELN ('      OFF to finish logging')
            END ELSE BEGIN
               READSTR (INPUTSTRING, Answer);
               UPCASE (Answer);
               IF Answer = 'ON'  THEN
                IF Debug THEN (* DEBUG was already ON ! *)
                ELSE BEGIN
                 Debug := TRUE;
                 TSOService ('FREE F(DFILE)', RC);
                 TSOService ('DELETE ' || DEBUGNAME, RC);
                 TSOCommand := 'ALLOC F(DFILE) DA(' || DEBUGNAME ||
                               ') NEW SP(1,1) CYL ' || DCB_DEBUG;
                 TSOService (TSOCommand, RC);
                 IF RC < 8 THEN REWRITE (DFILE)
                 ELSE BEGIN
                    Debug := FALSE;
                    WRITELN ('Debug file could not be allocated, ',
                             'return code is ', RC)
                 END
                END;
               IF Answer = 'OFF' THEN
                IF Debug THEN BEGIN
                  Debug := FALSE;
                  CLOSE (DFILE);
                  TSOService ('FREE F(DFILE)', RC)
                END ELSE (* DEBUG was already OFF ! *);
               WRITE ('Debug mode now set to ');
               IF Debug THEN WRITELN ('ON') ELSE WRITELN ('OFF')
             END;
   $REPCHAR :                                    (* SET repeat char *)
            IF INPUTSTRING(.1.) = '?' THEN
               WRITELN ('Enter character to be used as repeat quote')
            ELSE BEGIN
               READSTR (INPUTSTRING, Temp);
               IF INDEX (SPECTABLE, Temp) > 0 THEN
                  REPEATCHAR := Temp (.1.) ELSE REPEATCHAR := '~';
               WRITELN ('REPEAT CHAR is ', REPEATCHAR)
            END;
   $SOHCHAR :                                    (* SET repeat char *)
            IF INPUTSTRING(.1.) = '?' THEN
         WRITELN ('Enter decimal value (1..18) used as soh character')
            ELSE BEGIN
               IF INPUTSTRING (.1.) = '-' THEN
                  INPUTSTRING := SUBSTR (INPUTSTRING, 2);
               READSTR (INPUTSTRING, SCHAR);
               IF (SCHAR < 1) OR (SCHAR > 18) THEN SCHAR := 1 ;
               SOH := CHR (SCHAR);
               WRITELN ('SOHCHAR     is ', SCHAR, ' decimal(ascii)')
            END;
   $ATOE:                              (* SET ASCII -> EBCDIC table *)
            IF INPUTSTRING(.1.) = '?' THEN BEGIN
               WRITELN ('Enter two numbers, the first is the entry in');
               WRITELN ('the ASCII table, the second the correspond.');
               WRITELN ('EBCDIC char. The valid range is (1 .. 255) ')
            END
            ELSE BEGIN
               READSTR (INPUTSTRING, N1, N2);
               IF (N1 < 1) OR (N1 > 255) THEN RETURN;
               IF (N2 < 0) OR (N2 > 255) THEN RETURN;
               ASCIITOEBCDIC (.N1.) := CHR (N2);
               WRITELN ('ASCII (', N1:3,') has now the value of ',
                        'EBCDIC (', N2:3,')')
            END;
   $ETOA:                              (* SET EBCDIC -> ASCII table *)
            IF INPUTSTRING(.1.) = '?' THEN BEGIN
               WRITELN ('Enter two numbers, the first is the entry in');
               WRITELN ('the EBCDIC table, the second the correspon.');
               WRITELN ('ASCII char. The valid range is (1 .. 255) ')
            END
            ELSE BEGIN
               READSTR (INPUTSTRING, N1, N2);
               IF (N1 < 1) OR (N1 > 255) THEN RETURN;
               IF (N2 < 0) OR (N2 > 255) THEN RETURN;
               EBCDICTOASCII (.N1.) := CHR (N2);
               WRITELN ('EBCDIC (', N1:3,') has now the value of ',
                        'ASCII (', N2:3,')')
            END;
   $INCOMPLETE:                            (* SET incomplete option *)
            IF INPUTSTRING(.1.) = '?' THEN BEGIN
               WRITELN ('Enter options KEEP or DELETE to control the');
               WRITELN ('disposition of an incomplete file.')
            END
            ELSE BEGIN
               SETTING := GETTOKEN (INPUTSTRING);
               UPCASE (SETTING);
               IF (SETTING = 'DELETE  ') OR (SETTING = 'DEL     ') THEN
                  Incomplete_File := FALSE;
               IF SETTING = 'KEEP    ' THEN
                  Incomplete_File := TRUE
            END;
   $DUMMY: WRITELN ('NOT YET implemented ');

   OTHERWISE BEGIN                         (*  Invalid SET  OPTION  *)
     WRITELN ('SET ', REQUEST, ' - invalid option specified.');
     WRITELN ('Valid   OPTIONS are :   ');
     WRITELN ('----------------------- ');
     WRITELN (' ');
     WRITELN (' BIT8_QUOTE   c     - Bit8 quote character');
     WRITELN (' CHECK        n     - Block check type');
     WRITELN (' CNTRL_QUOTE  c     - Quote character');
     WRITELN (' DELAY        nnn   - Delay factor');
     WRITELN (' DEBUG       ON/OFF - Debug mode ');
     WRITELN (' EOLCHAR      nn    - Endline char (decimal)');
     WRITELN (' INCOMPLETE KEEP/DEL- Disposition of incomplete files');
     WRITELN (' PACKETSIZE   nn    - Packet size (decimal)');
     WRITELN (' RECFM       VB/FB  - Variable or Fixed');
     WRITELN (' REPEATCHAR   c     - Repeat char');
     WRITELN (' SOHCHAR      nn    - Start of packet (decimal)');
     WRITELN (' TEXTMODE    ON/OFF - for text / binary files');
   END
  END
END; (* SetIT  procedure *)

%TITLE Procedure Help
(******************************************************************)
(* Help   -    This routine handles the HELP COMMAND.             *)
(******************************************************************)
PROCEDURE Help;
BEGIN
 WRITELN (' The following are the valid KERMIT-TSO commands : ');
 WRITELN (' ');
 WRITELN (' SEND filename      - send a file to the micro');
 WRITELN ('      as! filename! (you may select the new name)');
 WRITELN (' RECEIVE filename! - receive a file from the micro');
 WRITELN (' SERVER             - go into server mode');
 WRITELN (' SET option value   - set OPTION to VALUE');
 WRITELN (' STATUS             - displays current options settings');
 WRITELN (' TAKE filename      - execute commands from a file');
 WRITELN (' DO   membername    - execute commands from your profile');
 WRITELN (' HELP               - displays this information');
 WRITELN (' EXIT, END or QUIT  - exit KERMIT , terminate program');
 WRITELN (' LOGOUT             - exit KERMIT and logoff from host');
 WRITELN (' ');
 WRITELN ('Additional TSO facilities:');
 WRITELN (' DELETE filename    - deletes cataloged data set');
 WRITELN (' DIR userid!       - shows user directory');
 WRITELN (' DISK               - displays disk usage');
 WRITELN (' MEMBERS filename   - shows member list of a file');
 WRITELN (' TSO command        - issues a TSO command');
 WRITELN (' TYPE filename      - displays data set at the screen');
 WRITELN (' WHO                - shows users logged in on the host');
END ; (* HELP procedure *)

%TITLE Procedure Micro_Finish;
(*******************************************************************)
(* Micro_Finish - This routine turns down a micro's KERMIT running *)
(*                in server mode (used only with setup-files).     *)
(*******************************************************************)
PROCEDURE Micro_Finish;
VAR Ok : BOOLEAN;
BEGIN
  OUTSEQ := 0;
  OUTPACKETTYPE := 'I';
  ParmPacket;
  SendPacket;
  IF RecvPacket AND (INPACKETTYPE='Y') THEN (* Ok *)
     ELSE ReSendit(10);
  OUTDATACOUNT  := 1;
  OUTSEQ        := 0;
  OUTPACKETTYPE := 'G';
  SENDMSG.CHARS := 'F';
  SendPacket;
  IF RecvPacket AND (INPACKETTYPE='Y') THEN  (* Ok *)
     ELSE ReSendit(10)
END;  (* Micro_Finish *)

%TITLE Procedure RemoteCommand
(*******************************************************************)
(* RemoteCommand -This routine handles the COMMANDS from a remote  *)
(*                kermit.                                          *)
(*******************************************************************)
PROCEDURE RemoteCommand;

CONST
  COMMANDTABLE     = 'CEGIRSYK';
  SUBCOMMANDTABLE  = 'ICLFDUETRKSPWMHQJV';

TYPE
  SUBCOMMANDTYPE = (ZERO,I,C,L,F,D,U,E,T,R,K,S,P,W,M,H,Q,J,V);

VAR
  COMMANDTYPE,
  SUBCOMMAND,
  B8Quote     : CHAR ;
  Ix          : INTEGER ;
  Ok          : BOOLEAN;
  TSOUser     : STRING (10);
  TSOFname    : STRING (80);
  XLine       : LString;
LABEL CHECKCOMMAND ;

(*-----------------------------------------------------------*)
(* Remote_Help - send help information to remote micro       *)
(*-----------------------------------------------------------*)
PROCEDURE Remote_Help;
BEGIN
SendDPacket
   ('This is the KERMIT server running under MVS/XA TSO'||CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket (CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket
  ('The following server commands are actually supported:'||CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket (CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket
  ('  DELETE filename - erases a specific host file'||CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket
  ('  DIR             - displays your disk directory'||CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket
  ('  DISK            - displays the current disk usage'||CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket
  ('  FINISH          - finishes server mode on the host'||CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket
  ('  GET filename    - requests one or more files'||CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket
  ('  HELP            - displays this information page'||CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket
  ('  LOGOUT          - stops host KERMIT and logout'||CRLF, Ok);
IF NOT Ok THEN RETURN;
SendDPacket
  ('  SEND filename   - sends one or more files to the host'||CRLF,Ok);
IF NOT Ok THEN RETURN;
SendDPacket
  ('  TYPE filename   - displays a specific host file'||CRLF, Ok);
IF NOT Ok THEN RETURN
END; (* Remote_Help *)

%PAGE
BEGIN  (* RemoteCommand procedure *)
  INPUTSTRING  := Line;
  COMMANDTYPE  := INPUTSTRING(.4.);
  INPACKETTYPE := COMMANDTYPE;
  GetFile := FALSE;
  CHECKCOMMAND :
  IF INDEX (COMMANDTABLE, STR (COMMANDTYPE)) = 0 THEN BEGIN
     SendError ('Unknown commandtype, ' || STR (COMMANDTYPE));
     RETURN
  END;
  IF COMMANDTYPE = 'C' THEN BEGIN            (* HOST command *)
    INPUTSTRING := SUBSTR (INPUTSTRING, 5);
    SendYPacket ('Host Command not available')
  END;
  IF COMMANDTYPE = 'K' THEN BEGIN            (* KERMIT command *)
    INPUTSTRING := SUBSTR (INPUTSTRING, 5);
    SendYPacket ('KERMIT command not executed')
  END;
  IF COMMANDTYPE = 'E' THEN (* Got an error message back *);
  IF COMMANDTYPE = 'I' THEN BEGIN            (* INITIALIZE *)
    INDATACOUNT := ORD (EBCDICTOASCII (.ORD (INPUTSTRING(.2.)).))-32-3;
    IF INDATACOUNT >= 1 THEN
       PSIZE := ORD (EBCDICTOASCII (.ORD (INPUTSTRING (.4+1.)).))-32;
    IF INDATACOUNT>= 5 THEN
       ECHAR := ORD (EBCDICTOASCII (.ORD (INPUTSTRING (.4+5.)).))-32;
    IF INDATACOUNT>= 6 THEN CNTRL_QUOTE := INPUTSTRING (.4+6.) ;
    IF INDATACOUNT>= 7 THEN BEGIN
       B8Quote := INPUTSTRING (.4+7.);
       IF B8Quote = 'Y' THEN BIT8_QUOTE := '&';
       IF NOT (B8Quote IN (.'Y', 'N'.)) THEN
          BIT8_QUOTE := B8Quote
    END;
    IF INDATACOUNT>= 8 THEN CHECKTYPE  := INPUTSTRING (.4+8.)
       ELSE CHECKTYPE  := '1';
    IF INDATACOUNT>= 9 THEN REPEATCHAR := INPUTSTRING (.4+9.)
       ELSE REPEATCHAR := '~';
    IF INDATACOUNT >= 10 THEN
       CAPAS := ORD (EBCDICTOASCII (.ORD (INPUTSTRING (.4+10.)).))-32
       ELSE CAPAS := 0;
    IF INDATACOUNT >= 13 THEN BEGIN
       PSIZE := ORD (EBCDICTOASCII(.ORD(INPUTSTRING(.4+12.)).))-32;
       PSIZE := PSIZE * 95 +
                  ORD (EBCDICTOASCII(.ORD(INPUTSTRING(.4+13.)).))-32
    END;
    OUTPACKETTYPE := 'Y';
    CheckParms;
    ParmPacket ;
    SendPacket ;
    IF RecvPacket THEN
    BEGIN
      COMMANDTYPE := INPACKETTYPE ;
      INPUTSTRING := 'XXX'||  STR(INPACKETTYPE) ||
                     SUBSTR (STR (REPLYMSG.CHARS), 1, INDATACOUNT);
      GOTO CHECKCOMMAND
    END
  END;
  IF COMMANDTYPE = 'R' THEN BEGIN         (* Send to micro *)
    INPUTSTRING := SUBSTR (INPUTSTRING, 5);
    TSOFname := LTRIM (INPUTSTRING);
    IF Debug THEN WRITELN (DFILE, 'REM: Sending file(s)', TSOFname);
    SendFile (TSOFname, FALSE)
  END;
  IF COMMANDTYPE = 'S' THEN BEGIN            (* Receive from micro *)
    IF Debug THEN WRITELN (DFILE, 'REM: Receiving file(s) from micro');
    RecvFile
  END;
  IF COMMANDTYPE = 'Y' THEN (* Got an ACK for break packet *);
  IF COMMANDTYPE = 'G' THEN BEGIN                 (* GENERAL *)
    SUBCOMMAND := INPUTSTRING (.5.);
    OUTSEQ := 0;
    CASE SUBCOMMANDTYPE (INDEX (SUBCOMMANDTABLE, STR (SUBCOMMAND))) OF

         C:                                    (* CHANGE command *)
            SendError ('No CHANGE directory available under MVS');

         D: BEGIN                             (* DIRECTORY command *)
              TSOService ('TSODS LISTCAT' , RC);
              IF RC <> 0 THEN
                 SendYPacket ('No file(s) found for '|| UserID)
              ELSE BEGIN (* GOT directory *)
                OUTSEQ := 64;
                SendXPacket ('DIRECTORY for ' || UserID);
                RESET  (TSODS);
                WHILE NOT EOF (TSODS) DO BEGIN
                  READLN (TSODS, XLine);
                  XLine := XLine || CRLF;
                  SendDPacket (XLine, Ok);
                  IF NOT Ok THEN LEAVE
                END;
                CLOSE (TSODS);
                IF INPACKETTYPE='Y' THEN SendZPacket;
                IF INPACKETTYPE='Y' THEN SendBPacket
              END
            END;

         E: BEGIN                             (* Erase File command *)
              IF LENGTH (INPUTSTRING) > 7 THEN
                 TSOFname :=
                   SUBSTR (INPUTSTRING, 7, LENGTH (INPUTSTRING)-6);
              IF Debug THEN WRITELN (DFILE, 'Delete data set ' ||
                                     TSOFname);
              TSOService ('DELETE ' || TSOFname, RC);
              IF RC = 0 THEN TSOCommand := 'File deleted '
                        ELSE TSOCommand := 'Not deleted  ';
              SendYPacket (TSOCommand)
            END;

         F: BEGIN                              (* FINISH command *)
              RUNNING := FALSE ;
              SendACK (TRUE)
            END;

         H: BEGIN                                 (* HELP  command *)
              OUTSEQ := 64;
              SendXPacket ('');
              Remote_Help;
              IF INPACKETTYPE='Y' THEN SendZPacket;
              IF INPACKETTYPE='Y' THEN SendBPacket
            END;

         I:                                       (* LOGIN  command *)
            SendYPacket ('Already logged on');

         J:                                         (* Journal *)
            SendYPacket ('No Journal available, use DEBUG option');

         K:                                        (* Copy file   *)
            SendYPacket ('No Copy function available, yet');

         L: BEGIN                                 (* LOGOUT command *)
              RUNNING := FALSE ;
              EndKermit := TRUE;
              SendACK (TRUE)
            END;

         M:                                     (* MESSAGE  command *)
            SendYPacket ('No Message function available, yet');

         P:                                       (* Print  command *)
            SendYPacket ('No Print function available, yet');

         Q:                                 (* QUERY status command *)
            SendYPacket ('No Query state available');

         R:                                        (* Rename file *)
            SendYPacket ('No Rename function available, yet');

         S:                                       (* Submit command *)
            SendYPacket ('Submit command not implemented');

         T: BEGIN                              (* TYPE File command *)
              IF LENGTH (INPUTSTRING) > 7 THEN
                 TSOFname := SUBSTR (INPUTSTRING, 7,
                   ORD (EBCDICTOASCII (.ORD(INPUTSTRING(.6.)).))-32)
              ELSE BEGIN
                 SendError ('No file specified');
                 RETURN
              END;
              IF INDEX (TSOFname,'*') > 0 THEN
                SendError ('No * allowed for typing files')
              ELSE BEGIN
                OUTSEQ := 64;
                SendXPacket ('Typing file : ' || TSOFname);
                SendFile    (TSOFname, TRUE)
              END
            END;

         U: BEGIN                             (* Disk Usage command *)
              TSOService ('TSODS SPACE TOTAL', RC);
              IF RC <> 0 THEN SendError ('Error on Disk Space')
              ELSE BEGIN
                OUTSEQ := 64;
                SendXPacket ('Disk usage of ' || UserID);
                RESET (TSODS);
                FOR Ix := 1 TO 2 DO BEGIN
                  READLN (TSODS, XLine);
                  IF LENGTH (XLine) > 35 THEN
                     XLine := SUBSTR (XLine, 1, 35);
                  SendDPacket (XLine || CRLF, Ok);
                  IF NOT Ok THEN LEAVE
                END;
                CLOSE (TSODS);
                IF INPACKETTYPE='Y' THEN SendZPacket;
                IF INPACKETTYPE='Y' THEN SendBPacket
              END
            END;

         W:                                         (* WHO command *)
            SendYPacket ('Try WHO in interactive mode');

         OTHERWISE SendError ('Unknown subcommand')     (* ERROR *)
      END
   END
END ; (* REMOTECOMMAND procedure *)

%TITLE KERMIT - Main Program
(******************************************************************)
(********         OUTER BLOCK OF KERMIT                    ********)
(******************************************************************)

BEGIN
  TERMIN   (INPUT);   TERMOUT (OUTPUT);
  TermSize (ScreenSize);
  Remote   := FALSE; EndKermit := FALSE;
  TEXTMODE := TRUE;  Init_File := FALSE;
  RUNNING  := TRUE;  CmdMode   := FALSE;
  Handle_Attribute := FALSE;
  Long_Packet      := FALSE;
  IF INDEX (PARMS, '@INIT') = 0 THEN UserID    := PARMS
  ELSE BEGIN
     CmdMode   := TRUE;
     Init_File := TRUE;
     Remote    := TRUE;
     UserID    := SUBSTR (PARMS, 1, (INDEX(PARMS,'@INIT')-1));
     TSOCommand := 'ALLOC F(CMDFILE) DA(' || CMDNAME || ') SHR REUSE';
     TSOService (TSOCommand, RC);
     RESET (CmdFile);
  END;
  TSOService ('DELETE TSODS', RC);
  TSOCommand := 'ALLOC F(TSODS) DA(TSODS) NEW TR SP(1,1) ' || DCB_Var;
  TSOService (TSOCommand, RC);
  WRITELN('Welcome to KERMIT under MVS/XA-TSO V2.3');
  WRITELN(' ');
  IF ScreenSize > 0 THEN BEGIN
     WRITELN (' You are running Kermit-TSO from a full-screen device.');
     WRITELN (' There is no filetransfer supported in this mode.');
     WRITELN (' ')
  END;
  WHILE RUNNING DO BEGIN (* Command Loop *)
    MAINLOOP: (* NORMAL IO *)
    IF CmdMode THEN BEGIN
       IF NOT EOF (CmdFile) THEN READLN (CmdFile, INPUTSTRING)
       ELSE BEGIN
          INPUTSTRING := ' ';
          CmdMode     := FALSE;
          Remote      := TRUE;
          CLOSE (CmdFile)
       END
    END ELSE Prompt ('KERMIT-TSO>', INPUTSTRING) ;
    IF (BIT8_QUOTE = '00'XC) AND (NOT TEXTMODE) THEN BEGIN
      WRITELN ('**** WARNING - TEXT MODE is turned off, other');
      WRITELN ('               KERMIT can not handle the 8th bit.')
    END ; (* Warning *)
    GetFile := FALSE;
    INPUTSTRING := LTRIM(INPUTSTRING);
    IF INPUTSTRING = ' '  THEN GOTO MAINLOOP;
    IF SUBSTR(INPUTSTRING,1,1) = STR (SOH) THEN RemoteCommand
       ELSE BEGIN (* Local Command *)
         INPUTSTRING := LTRIM (INPUTSTRING);
         COMMAND := GETTOKEN (INPUTSTRING);
         UPCASE (COMMAND);
         REQUEST := ' ' || TRIM (STR (COMMAND));
         CINDEX := INDEX(COMMTABLE,REQUEST) DIV 8 ;
         CASE COMMANDS(CINDEX) OF
           $BAD    : WRITELN (COMMAND, 'is an invalid command.');
           $SEND   : SendFile (INPUTSTRING, FALSE);
           $RECEIVE: BEGIN
                       INPUTSTRING := LTRIM(INPUTSTRING);
                       IF INPUTSTRING = ' ' THEN BEGIN
                          Remote := TRUE;
                          WRITELN ('ready to RECEIVE file  - ',
                            'SEND file(s) from Micro. ');
                          Waiting (Delay)
                       END;
                       RecvFile;
                       Remote := FALSE
                     END;
           $SERVER : BEGIN
                       WRITELN('Entering SERVER mode - ',
                               'Issue FINISH or LOGOUT command from',
                               ' micro to stop SERVER');
                       IF Debug THEN
                          WRITELN (DFILE, 'Entering SERVER mode ...');
                       Remote    := TRUE;
                       REPEAT
                        STATE := S_I; (* Server_Init state *)
                        IF RecvPacket THEN BEGIN
                          Line := '   ' || STR (INPACKETTYPE) ||
                           SUBSTR(STR(REPLYMSG.CHARS),1,INDATACOUNT);
                          IF Debug THEN WRITELN (DFILE,'>>',Line);
                          RemoteCommand
                        END;
                       UNTIL NOT RUNNING;
                       IF Debug THEN
                          WRITELN (DFILE, 'SERVER mode ended');
                       Remote := FALSE;
                       IF NOT EndKermit THEN RUNNING := TRUE
                     END;
           $SET    : SetIT;
           $SHOW,
           $STATUS : ShowIT;
           $HELP,
           $QUES   : HELP ;
           $DEL    : BEGIN
                       TSOService ('DELETE ' || INPUTSTRING, RC);
                       IF RC > 0 THEN WRITELN ('Data set ' ||
                                 INPUTSTRING || ' not deleted');
                     END;
           $DIR    : IF INPUTSTRING = ' '
                        THEN TSOService ('LISTCAT ', RC)
                        ELSE TSOService ('LISTCAT LEV(' ||
                                          INPUTSTRING  || ')', RC);
           $DISK   : BEGIN
                        WRITELN ('Total disk space in tracks:');
                        TSOService ('SPACE TOTAL ', RC)
                     END;
           $MEM    : IF INPUTSTRING <> ' ' THEN BEGIN
                        INPUTSTRING := TRIM (INPUTSTRING);
                        CheckDsn (INPUTSTRING, DsnDisp);
                        IF DsnDisp = SHARE THEN
                           WRITELN ('File ', INPUTSTRING,
                                    ' is sequential')
                        ELSE IF DsnDisp = NEW THEN
                           WRITELN ('File ', INPUTSTRING,
                                    ' does not exist')
                        ELSE BEGIN
                           RESET   (TSODS);
                           FOR I := 1 TO 7 DO READLN  (TSODS, Line);
                           IF INDEX (Line, 'NOT USEABLE') > 1 THEN
                           WRITELN ('No access to file: ', INPUTSTRING)
                           ELSE BEGIN
                              WRITELN ('Memberlist for: ', INPUTSTRING);
                              I := 1;
                              WHILE NOT EOF (TSODS) DO BEGIN
                                 WRITE  (Line:-12);
                                 READLN (TSODS, Line);
                                 I := I + 1;
                                 IF I > 5 THEN BEGIN
                                    WRITELN; I := 1 END;
                              END; WRITELN (Line:-12)
                           END;
                           CLOSE   (TSODS)
                        END
                     END
                     ELSE WRITELN ('No file specified');
           $TSO    : BEGIN
                       TSOService (INPUTSTRING, RC);
                       IF RC <> 0 THEN
                       WRITELN (' TSO command ended with error ', RC)
                     END;
           $TYPE   : BEGIN
                       TSOService ('LIST ' || INPUTSTRING, RC);
                       IF RC > 0 THEN WRITELN ('Data set ' ||
                                 INPUTSTRING || ' not found');
                     END;
           $WHO    : TSOService ('USERS ', RC);
           $FINISH : IF NOT CmdMode THEN WRITELN ('Nothing happens ...')
                     ELSE Micro_Finish;
           $QUIT,
           $END,
           $EXIT   : RUNNING := FALSE;
           $LOG    : IF (COMMAND = 'LOG') OR (COMMAND = 'LOGOUT')
                     THEN BEGIN
                       RUNNING   := FALSE ;
                       EndKermit := TRUE
                     END;
           $DO,
           $TAKE   : IF INPUTSTRING = '' THEN
                          WRITELN ('No commandfile specified')
                     ELSE IF CmdMode THEN (* Do nothing *)
                        ELSE BEGIN
                          IF COMMANDS(CINDEX) = $DO THEN
                             INPUTSTRING := PROFNAME || '(' ||
                                            TRIM(INPUTSTRING) || ')';
                          TSOCommand := 'ALLOC F(CMDFILE) DA(' ||
                                        INPUTSTRING || ') SHR REUSE';
                          TSOService (TSOCommand, RC);
                          IF RC <= 4 THEN BEGIN
                             CmdMode := TRUE;
                             Remote  := TRUE;
                             RESET (CmdFile)
                          END ELSE WRITELN ('Commandfile not found')
                       END;
           $VERSION: BEGIN
                       WRITELN (' This is the KERMIT filetransfer ',
                        'program for IBM System 370 under MVS/TSO.');
                       WRITELN (' The actual version number is 2.3',
                        ', featuring long packets ... Fritz B.')
                     END;
           OTHERWISE WRITELN (COMMAND, ' is an INVALID command');
         END  (* Execute the Command *)
      END; (* Local Command *)
      INPUTSTRING := ''
   END ; (* Command Loop *)
   IF Debug THEN CLOSE (DFILE);
   IF CmdMode THEN CLOSE (CmdFile);
   TSOService ('FREE F(TSODS) DELETE', RC);
   IF EndKermit THEN TSOService ('TSOEXEC LOGOFF',  RC);
   WRITELN('End of KERMIT  ')
END.
