Columbia Kermit/kermit.zip/hp1000/kermit.ftn

Text File | 2020-01-01 | 172KB | 4,486 lines

ftn7x,s
      program kermit(6,49)                               ,<890525.1144>
     >File transfer utility
      implicit none

!     HP-1000 KERMIT main program
!
!     rev     date        reason..........................................
!     1.98a   23Jul86     First release to CUCCA (supersedes all previous)
!     1.98b   06Aug86     receive/get with rename lost DS info in mask
!                         >>> Released to Interex Detroit swap tape
!     1.98c   09Oct86     Repaired checksum-type parameter-return [recpar]
!     1.99    10Apr87     New CONNECT removes mux lockups; altered CONTROL
!                         and SLEEP routine to go with new CONNECT.  A lot
!                         of reorganization, moving system-dependent code
!                         to KxSUBS (x=A or 6 for RTE-A or RTE-6).  This
!                         makes KERMIT a transportable program!
!     1.99a   14Jul87     Fix in GetMux (KASUBS) for tracking down the DVT
!                         address (near statement label 10).  Several fixes
!                         for compatibility with RTE revision 5.0.
!     1.99b   16Oct87     Fix in ReportFileError to load 3rd segment before
!                         calling SndErr; fix in Connect to (hopefully) let
!                         B- and C-mux terminal-emulation work under RTE-A.
!     1.99c   Jun '88     More fixing to Connect - it is now tested with a
!                         12040D and 12040C, and with a 12792C.  Hopefully
!                         this is the last I need to hear about this!
!                         >>> Released to Interex 2830 CSL tape
!     1.99d   May '89     Fix in RINIT to properly handle timeout.  Now
!                         supports "D" mux on both RTE-A and RTE-6!
!                         >>> Released to CUCCA in Dec. '89
!
!     Permission is granted to any individual or institution to copy
!     or use this program, except for explicitly commerical purpose.
!
!     RTE-6/VM KERMIT was originally implemented by John Lee, of
!     RCA Laboratories 6/29/84.
!
!     Heavily modified by Paul Schumann at E-Systems, Inc. beginning
!     11/09/84 for a "full" implementation of KERMIT, including local-
!     host mode, server operation, and hierarchical file access, on
!     both RTE-6 and RTE-A.
!
!     Installation instructions:
!
!         KERMIT is designed to work on both RTE-6 and RTE-A systems from
!         the C.83 revision (first appearance of CI file space) or later.
!         In order to minimize the installation time, all of the system-
!         dependent code has been moved to K6SUBS.FTN (for RTE-6/VM) or
!         KASUBS.FTN (for RTE-A); the link command-file KERMIT.LOD will
!         select the appropriate routines when you link.
!
!         NOTE: the KERMIT relocatables you received are already set for
!               any system revision from A.84 to 4.1.  If you are actually
!               using a C.83 system, you must edit KERCOM.ftni and change
!               the "SysRev" parameter to any value less than 2440, then
!               recompile KERMIT.  It should not be necessary to recompile
!               KASUBS or K6SUBS.  Failure to do this will result in an
!               undefined external reference to FTRAP.  If you force-load
!               KERMIT, you will be told to make the change just described,
!               and then KERMIT will abort.
!
!         Link KERMIT using the supplied KERMIT.LOD.  Undefined external
!         references (except for FTRAP - see above) are caused by failure
!         to use the correct KERMIT library file (KASUBS or K6SUBS) or be-
!         cause your system is simply too old (before C.83).
!
!         Copy KERMIT.HLP to the /SYSTEM or /KERMIT directory, or if you
!         have no CI space, copy it as "KERMI to any FMGR space.  This
!         file is generated by running the RTE-6 GENIX utility against
!         the KERMIT.TEXT file, which is user-editable.  You need not
!         rebuild KERMIT.HLP if you have not altered KERMIT.TEXT.
!
!                                               Paul Schumann
!                                               E-Systems, Inc.
!                                               PO Box 1056 CBN 148
!                                               Greenville, TX  75401
!                                               [phone]
!
!     A note on the programming style...
!     I use IMPLICIT NONE in order to protect myself from typos
!     (I am a terrible typist); obviously this means that I must
!     define all symbols before I use them.  I have attempted as
!     much as possible to make the symbol names self-documenting,
!     but I don't LIKE to type either, so I use very short names
!     which I prefixed as follows:
!         fiXx is a variable pertaining to the current file being
!             sent or received
!         dbXx is a variable pertaining to some debugging
!         cmXx is a variable pertaining to the command line
!         fXxx is a logical flag of some type
!
!     I firmly adhere to the concept of "data hiding" as a tool to improve
!     software reliability: a module cannot change a variable if it has no
!     access to it.  I have a number of common blocks with separate include
!     files so that a routine which needs access to control variables but
!     which needs no access to file variables can have exactly that access.
!     Would-be KERMIT modifiers should keep this in mind before they decide
!     to re-combine the common include-files.  (It also improves compiler
!     speed when FTN7X doesn't need to keep up with a lot of unused symbol
!     names!)
!
!     In the interest of saving paper, the complete listings of all common
!     blocks appear only in the block-data routine.  I regret any problems
!     this may cause.
!
!     The following is a definition of ALL variables in /KER/, the
!     main control common block for KERMIT-RTE.  Variables are defined
!     in storage order (for cross-referencing to /KER/ itself).  The
!     numbers in parentheses after a variable name (if any) give the
!     storage allocation in 16-bit words; if absent, assume 1 word.
!
!     SysRev(0)    - the highest system revision-code expected by this
!                    KERMIT version
!     Delay        - # of seconds waited before sending out the first
!                    SINIT packet (only in remote mode).
!     EOL          - End of line delimiter required by other KERMITS.
!     EsChar       - The character used to return back to command mode
!                    from CONNECT.
!     L            - Local TTY channel (to which the user is logged)
!     ImxTry       - Maximum number of retries/packet before giving up on
!                    start-up of a [group] file-transfer
!     MaxTry       - maximum number of retries/packet before giving up on
!                    any packet once transfers are already under way
!     R            - Remote TTY channel (to which user is NEVER logged)
!                    This is also the local channel if KERMIT is in
!                    remote-host mode.
!     p            - a general-purpose byte pointer variable; used by
!                    pPutc and its callers in building a packet
!     rlen         - The data length of the last packet received
!     Seq          - The sequence number of the current packet
!     Class        - The class# to use during CONNECT mode.
!     slen         - The data size of the next packet to send
!     trCb(144)    - Transfer-file control block
!     fePath       - An assigned label.  If a file error of some kind
!                    occurs, execution will continue at (fePath) after
!                    the error is processed.  Only the KERMIT main and
!                    the SERVER subroutine should ever change fePath!
!     sPcnt        - The number of parameters the other KERMIT sent me.
!                    (Some KERMITs don't like to see more parameters than
!                     they sent out, notably an older IBM-PC version...)
!     Parity       - The parity of the remote line:
!                     1 = Even       2 = Mark       3 = None
!                     4 = Odd        5 = Space

!     My packet parameters follow:

!     PakSiz       - The maximum packet size I want to receive
!     Timeout      - Time (sec) the other KERMIT should wait for me to
!                  - send a packet (0 means wait forever)
!     nPad         - The # of pad characters I require (I require none)
!     EOLch        - The terminator I require at the end of each packet;
!                  - this is hard-coded to 13 (carriage-return)!
!     Quote        - The character I must see before control characters
!     Bit8         - The character I must get if the next data byte is
!                    to have its 8th bit set
!     ChkTyp       - the checksum type I want to receive on packets
!     Repc         - The character which tells me a repeat-count follows
!     capas(2)     - My capabilities bits (I can do time-out; I accept
!                    server commands; I can send/receive attribute packets)
!     Sync         - the character with which my incoming packets start

!     My partner's packet parameters follow:

!     sPkSiz       - the maximum packet size I am allowed to send
!     sTime        - Time (sec) I will wait for a packet from my partner
!                    (0 means wait forever)
!     sPad         - The number of pad characters my partner needs
!     sPadch       - The character my partner wants for padding
!     sEOL         - My partner's packet-terminator character
!     sQuote       - The character I must put before control characters
!     sBit8        - The character I must send before sending a character
!                  - whose 8th-bit is set
!     sCheck       - My partner's checksum type
!     sRepc        - The character my partner will use before repeat counts
!     sCapas(2)    - My partner's capability bits
!     sSync        - The character I must send as the start of a packet

!     Assorted flags follow

!     fWarn        - True if file-overwrite warning is desired
!     fIBM         - True if talking to a CMS KERMIT, false otherwise
!                    If true, I must wait for a DC1 (XON or ^Q) before I
!                    can send anything.  Additionally, if I am CONNECTed,
!                    I will locally echo keystrokes.
!     fServ        - True if in server mode, false otherwise
!     fTrans       - True if commands are coming from a transfer-file
!     fBit8        - True if I am doing 8th-bit quoting
!     fRepc        - True if I am doing repeat-count prefixing
!     fPkIO        - True if I am doing packet-I/O
!     fSend        - True if sending a file; false if receiving a file
!                    (valid only during file-transfers)
!     f8OK         - True if 8th-bit quoting is enabled

!     String things follow

!     HlpNam(32)   - the file-descriptor for KERMIT's help file
!     Packet(50)   - A character array which holds the outgoing packet
!     RecPkt(128)  - A character array which holds the incoming packet
!     pData(48)    - A character array for the data part of a packet
!     state        - The current file-transfer state
!     ErrMsg(36)   - Text of most recent error-message (SndErr takes
!                    the error-packet text from this variable!)
!     Prompt(10)   - The string used as a command-prompt

!     Other labeled common areas:
!         /KCMNDS/ forms KERMIT-RTE's vocabulary
!         /KERCMD/ holds the current command-line & parameters
!         /KERCNF/ holds configuration info for the system and for the
!                  two LUs KERMIT is currently using
!         /KERDBG/ holds (self) debugging parameters
!         /KERFIL/ holds control parameters for the file being sent or
!                  received currently.
!         /KERSTA/ holds file-transfer statistical information

!     WARNING -- KERMIT uses "unusual" techniques in order to keep a large
!         program comfortably within the address space, while maintaining
!         the functionality.  These are:
!         1)  'ASSIGN nn to fePath' appears in KERMIT's main program only.
!             "fePath" is a variable in KERCOM which is used only by the
!             file-error reporting routine, ReportFileError, to return to
!             the main quickly without propagating an error-code through
!             the subroutine call-chain.  WARNING: this usage alone makes
!             KERMIT unfit for Code and Data Separation (CDS), although
!             there is a CDS-compatible method which performs the same job.
!         2)  KERMIT is segmented in an unusual way: all modules in the
!             segments (except for the "segment header") are subroutines or
!             functions that are called FROM SOME PART OF THE MAIN!  This
!             method was used to reduce KERMIT (1.97 and previous revisions)
!             from 31 pages (under RTE-A) to 24 before the RUn command was
!             added.  This "feature" makes KERMIT unfit for LOADR; you must
!             use LINK.  (Actually, there is a method by which LOADR can be
!             made to load this KERMIT, but it involves splitting the object
!             files at segment boundaries -- it isn't worth the trouble!)
!
!         If you find bugs in KERMIT, please let me know!  I can advise you
!         in the most expedient wat to fix them, as well as fix them for
!         other KERMIT users.  If you contemplate extending the capabilities
!         of this KERMIT, be sure you understand the segmenting method.  A
!         few guidelines are:
!             a)  If it is already in the main, don't move it to any of
!                 the segments, or you'll probably lose return addresses!
!             b)  If it parses an interactive command, at least some of it
!                 must be in K1CMD's (command processing) segment.
!             c)  If it deals ONLY with communicating to the other end
!                 (file-transfers or server), it >>probably<< belongs in
!                 K3XFR's (packet-transfer) segment.
!             d)  K2MSK's segment may appear the smallest in terms of the
!                 number of source lines, but all of the file-masking code
!                 loads there.  It is still the smallest segment, but it's
!                 unlikely that any more useful code could be put there.
!             e)  If it may be called from 2 or more segments, and all
!                 calls it makes are to the system or other modules in
!                 the main only, it >>probably<< belongs in the main.
!
!     I apologize in advance for any problems this may cause the reader.

      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      integer*2 loglu,junk
      logical*2 succeed,send,receive

      L = loglu(junk)                     !Get user's I/O channel
      do junk = 3,1,-1                    !Insure all segments load
          call LoadSeg(junk)              !...ending with command-processor
      end do

!     K1CMD performs initialization code on 1st entry only.

      assign 10 to fePath                 !Set File-error path

!     The following infinite loop is terminated by
!         a)  An exit-type command if interactive
!         b)  A finish-type command if serving

 10   if ( fServ ) then                   !Serving?
          call LoadSeg(3) $ call Server   !Yes - Server never returns
      else
          call LoadSeg(1) $ Call Command  !No - do interactive commands
      endif

!     A command requiring packet-I/O is ready to execute

      call LoadSeg(3) $ call PakIO        !Prepare for packet-I/O
      if (cmTk .eq. 'BYE') then
          call Bye
      else if (cmTk .eq. 'FINISH') then
          call Finish
      else if (cmTk .eq. 'GET') then
          call Get
      else if (cmTk .eq. 'RECEIVE') then
          succeed = receive('R')
          call success(succeed)
      else if (cmTk .eq. 'SEND') then
          if (L .eq. R) call sleep(delay)
          succeed = send()
          call success(succeed)
      endif
      cmCh = ' ' $ call NrmIO $ goto 10   !Get something else to do

      end

      Subroutine LoadSeg(SegNum)                         ,<890525.1144>
     >Overlay loader
      implicit none

      include kercom.ftni,NOLIST
      integer*2 SegNum,err,segn(3)
      character*6 cSegNam,SegNames(3)
      equivalence (cSegNam,segn)
      data SegNames /'K1CMD ','K2MSK ','K3XFR '/

      if (segnum .eq. seg) return         !Segment is already loaded
      cSegNam = SegNames(SegNum)
      call SegLd(segn,err)                !Try to load the segment
      if (err .ne. 0) then                !Did it load (and return)?
          call tpI2('Segment-Loader error _',err,0)
          call tpCh(' on -',cSegNam)
          stop 'aborting with segment-load problems'
      endif

      return
      end

      Subroutine tPrint                                  ,<890525.1144>
     >Term-print mini-formatter
      implicit none

      include kercom.ftni,NOLIST          !To define "L"

!     Define the names of all entry parameters

      integer*2 i2Var                     !Integer*2 variable to print
      integer*4 i4Var                     !Integer*4 variable to print
      integer*2 iflen                     !length of the integer field
      character*(*) chFmt                 !"format" string to print
      character*(*) chVar                 !character variable to print

      integer*2 tp,ioBuf(129),TrimLen,xl(2),cw
      logical*2 fReady                    !True when string ready to print
      integer*4 w4,mul
      character*20 IntToDecimal,DintToDecimal,chWk,jRight
      character chBuf*258
      equivalence (ioBuf,chBuf)
      data tp /1/                         !IO-buffer starts at byte# 1
      data cw /0/                         !No control bits on the LU

c     Formatting rules:
c         If a "format" ends with an underscore ("_") then the string
c             being built will not be printed on this call, but the
c             format string will be put in the I/O buffer without it.
c         If a "format" ends with a dash ("-") then the string being
c             built will be printed without it.  This allows trailing
c             blanks to be put in the format which would otherwise be
c             deleted.
c         The field length parameter is given as the number of digits
c             allowed for the formatted number if right-justification
c             is desired.  If the field length is positive, blanks are
c             padded on the left as needed; if negative, zeroes are
c             padded on the left.   If the field length is zero, the
c             number will be printed left-justified.
c         If the number being formatted occupies more characters in the
c             string than the field-length, the number will display as
c             (iflen) stars (just like the formatter!).
c         A maximum of 257 characters may ever be printed at one time.

      entry tpFm(chFmt)                   !Append a format only
      call CopyMore(chFmt,chBuf,tp,fReady)
      goto 10

      entry tpI2(chFmt,i2Var,ifLen)       !Append format and I*2 number
      call CopyMore(chFmt,chBuf,tp,fReady)
      chWk = jRight(IntToDecimal(i2var),iflen)
      chBuf(tp:) = chWk                   !Copy in the number
      tp = tp + TrimLen(chWk)             !Adjust the pointer
      goto 10

      entry tpI4(chFmt,i4Var,ifLen)       !Append format and I*4 number
      call CopyMore(chFmt,chBuf,tp,fReady)
      chWk = jRight(DintToDecimal(i4Var),iflen)
      chBuf(tp:) = chWk
      tp = tp + TrimLen(chWk)
      goto 10

      entry tpCh(chFmt,chVar,ifLen)       !Append format and string
      call CopyMore(chFmt,chBuf,tp,fReady)
      chBuf(tp:) = chVar
      if (ifLen .gt. 0) then              !Was a field-size given
          tp = tp + ifLen                 !Yes - "truncate" at that size
      else
          tp = tp + TrimLen(chVar)        !No - use all but trailing blanks
      endif

 10   tp = min(tp,258)                    !Don't overflow the string
      if (fReady) then                    !If string is ready to print...
          xl = L                          !Set LU in XLUEX control words
          call xluex(2,xl,iobuf,1-tp)     !...print it
          tp = 1                          !...and reset the pointer
      endif

      return
      end

      subroutine CopyMore(frm,dest,tp,fdone)             ,<890525.1144>
     >do "formats"
      implicit none

      character*(*) frm,dest
      integer*2 tp
      logical*2 fdone
      integer*2 i,TrimLen

      i = TrimLen(frm)                    !Where does the format end?

      if (frm(i:i) .eq. '_') then         !Are we finishing the buffer?
          fdone = .false.                 !No - flag it to caller
          i = i - 1                       !Don't copy continue flag to buf
      else
          fdone = .true.
          if (frm(i:i) .eq. '-') i=i-1    !Remove trailing-blanks flag
      endif

      if (i .gt. 0) then                  !Anything to copy?
          dest(tp:) = frm(:i)             !Copy the correct part
          tp = tp + i                     !adjust the pointer
          tp = min(tp,258)
      endif

      return
      end

      character*20 function jRight(chNum,flen)           ,<890525.1144>
     >do "Ix" formats
      implicit none

      character*(*) chNum
      integer*2 flen
      integer*2 i,ilen,TrimLen
      character*20 stars,blanks,zeroes
      data stars   /'********************'/
      data blanks  /'                    '/
      data zeroes  /'00000000000000000000'/

      ilen = iabs(flen)
      if (ilen .gt. 20) then
          call quit
          stop 'I-field length > 20 (jRight)'
      endif
      i = TrimLen(chNum)                  !How big is the number
      if (ilen .ne. 0) then               !Was a field-length given?
          if (i .gt. ilen) then           !Yes - will the number fit?
              jRight = stars(:ilen)       !No - replace number with stars
          else if (i .lt. ilen) then
              i = ilen - i                !fits ok; get # of fill bytes
              if (flen .lt. 0) then       !Doing zero or blank fill?
                  jRight = zeroes(:i) // chNum
              else
                  jRight = blanks(:i) // chNum
              endif
          else
              jRight = chNum              !exact fit
          endif
      else
          jRight = chNum                  !Else no formatting requested
      endif

      return
      end

      subroutine FtnTrap(abreg,preg)                     ,<890525.1144>
     >Trap FORTRAN errors
      implicit none

      include kercom.ftni,NOLIST
      include kerdbg.ftni,NOLIST

      integer*2 abreg(2),preg(2),abcod(3)
      character ecode*6, addr*8, IntToDecimal*6, IntToOctal*6
      equivalence (abcod,ecode)

!     If KERMIT incurs a FORTRAN error, it will most likely be a type-2
!     (always fatal) error.  The point of this routine is to insure the
!     restoration of all MUX configurations and file-closure should the
!     "impossible" happen.  In fact, the most likely error will be from
!     a string routine.  On completion of it's task, FtnTrap allows the
!     standard "runtime error" termination to occur.

      addr = IntToOctal(preg)//'/'//char(seg+48) !Format error addr/seg#

      if (abreg .lt. 20000b) then         !Group-2 error?
          ecode = IntToDecimal(abreg)     !Yes - format the number
      else
          abcod = abreg                   !Copy Group-1/-3 error to the
          abcod(2) = abreg(2)             !message
          abcod(3) = 2h                   !Clear the end of the message
      endif

      ErrMsg = 'Runtime error ' // ecode // ' @' // addr
      call kdebug(all,ErrMsg,' ')         !Try to log the error
      call LoadSeg(3) $ Call SndErr       !Do error-packet if in transfer

      call quit                           !Clean myself up
      return                              !allow me to abort
      end

      subroutine kdebug(type,header,info)                ,<890525.1144>
     >Do KERMIT debug logging
      implicit none

      include kerdbg.ftni,NOLIST
      integer*2     type
      character*(*) header,info
      integer*2     LogBf,TrimLen,err
      character*150 LogCh
      equivalence   (LogCh,LogBf)

c     This routine performs the debug logging requested by KERMIT's
c     user.  If debug logging of (type=STATES, PACKET, or ALL) is
c     enabled and logging is not suspended, then (header) and (info)
c     are concatenated into a log record and written to the log file.

      if (dbLv .lt. 1) return             !No debugging is active
      if (iand(type,dbLv) .ne. 0) then    !Logging this type of stuff?
          LogCh = ' ' // header // info   !Yes - form the record
          call FmpWrite(dbCb,err,LogBf,TrimLen(LogCh))   !...& write it
          call FmpPost(dbCb,err)
      endif                               !IGNORE file-write errors!

      return
      end

      subroutine quit                                    ,<890525.1144>
     >Terminate KERMIT cleanly
      implicit none

      include kerfil.ftni,NOLIST          !Defines fiCB and maCB
      include kercom.ftni,NOLIST          !Defines trCB, R, and L
      include kercnf.ftni,NOLIST          !Defines fRmx and fLmx
      include kerdbg.ftni,NOLIST          !Defines dbCB
      integer*2 junk

      call FmpClose(fiCB,junk)
      call FmpClose(dbCB,junk)
      call FmpClose(trCB,junk)
      call FmpEndMask(maCb)

      !The next line is an attempt to prevent both ends of a CPU-CPU
      !link from trying (and always failing) to log each other on.
      !Hopefully, 5 seconds is enough time for logout- or program-
      !termination activity to stop before this side's interrupts
      !get re-enabled.

      if (R .ne. L) then
          call sleep(500)
          call restore(L)                 !Restore local configuration
          call enable(L,fLmx)             !...and interrupt-scheduling
      endif

      call restore(R)                     !Restore remote configuration
      call enable(R,fRmx)                 !Restore remote interrupt-sched

      call lurq(100000b)                  !Release any locks I've done
      return

      end

      real*4 function control(lu,fcn,param)              ,<890525.1144>
     >Perform control calls
      implicit none

      real*4 rstat
      integer*2 lu,fcn,param,xl(2),cw
      equivalence (xl(2),cw),(xl,rstat)

!     While this routine is >never< actually called as a function, we define
!     it as such so that ABReg will work to return the status of the control
!     request to the caller (as used by connect).

      xl = lu
      cw = fcn
      call xluex(3,xl,param)              !Perform the control function
      call abreg(xl,cw)                   !get the status of the request
      control = rstat                     !Return it to the caller

      return
      end

      subroutine ReportFileError(err,nam)                ,<890525.1144>
     >Report file errors
      implicit none

c     Since it is the nature of this routine to never return to its
c     caller, we will ALWAYS close the current file (being sent or
c     received) as well as terminating any masked-/indirect-search
c     operation in progress

      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      include kerdbg.ftni,NOLIST
      include kerfil.ftni,NOLIST
      integer*2 err,j,TrimLen
      character*(*) nam

      cmCh = ' '                          !Clear the current command
      call FmpError(err,ErrMsg)           !Decode the error-number
      j = TrimLen(ErrMsg) + 1             !Find the end of the text
      if (TrimLen(nam) .gt. 0) then
          ErrMsg(j:) = ': ' // nam        !Tack on the file-name
      endif

      call FmpClose(fiCb,err)             !Shut down file/mask operations
      call FmpEndMask(maCb)

      call kdebug(all,ErrMsg,' ')         !Log the error-message (debug)
      call LoadSeg(3) $ Call SndErr       !If in packet-I/O, do error-pkt

      if (R.eq.L .and. .not. fServ) then
          call NrmIO                      !Restore "local" in remote-host
      endif

      goto fePath                         !Return to KERMIT MAIN PROGRAM

      end

      subroutine Server                                  ,<890525.1144>
     >Be a KERMIT Server
      implicit none

c     The only way out of this, once begun, is to receive a FINISH or
c     BYE command from the other KERMIT.

      include kercom.ftni,NOLIST
      include kercnf.ftni,NOLIST          !Defines fRmx
      include kerdbg.ftni,NOLIST
      include kerfil.ftni,NOLIST
      integer*2 len,num
      logical*2 receive,send
      character*1 pt,RecPack

 10   call Set_Timeout(R,9000,fRmx)       !Do 90-second server timeout
      sCheck = 1                          !Server commands use 1-byte checks
      call LoadSeg(3)                     !Insure file-xfr subs are callable
      call PakIO                          !Set flags for packet-I/O

      pt = RecPack(len,num)               !Get a command packet

      if (pt.eq.'S' .or. pt.eq.'I') then  !Send file or initialize?
          seq = num                       !Yes - make seq# agree
          fSend = .false.                 !Do param-stuff like a receive
          call RecPar(len)                !Get partner's parameters
          if (fBnry .and. Parity.ne.3 .and. .not.fBit8) then
              ErrMsg = 'Can''t receive binary file (parity problem)'
              call SndErr
              fBnry = .false.
              goto 10
          endif
          if (pt .eq. 'I') call doIpacket !Change my params to remote's vals
          call SndPar('Y',seq)            !...and send mine
          if (pt .eq. 'S') then           !Actually send a file?
              sCheck = NewChk             !OK to change checksum type now
              first = .true.              !Allow LEGALIZE to process RMASK
              mask = rmask                !Set the receive mask
              seq = mod(seq+1,64)
              if (receive('F')) then
                  call kdebug(all,'Server receive completed',' ')
              else
                  call kdebug(all,'Server receive failed',' ')
              endif
          endif
      else if (pt .eq. 'R') then          !Send file(s)?
          first = .true.                  !Prepare to do file masking
          fiNm = ' '                      !Clear old file name
          mask = RecPkt(5:len+4)          !Get the file mask
          if (send()) then
              call kdebug(all,'Server send completed',' ')
          else
              call kdebug(all,'Server send failed',' ')
          endif

      else if (pt .eq. 'G') then          !Generic command?
          pt = RecPkt(5:5)                !Get the data field
          if (pt .eq. 'F') then           !Finish?
              call SndPack('Y',num,0)     !Yes - acknowledge it
              call quit                   !Turn off everything
              call exec(6)                !...and stop

          else if (pt .eq. 'L') then      !Bye (logout)?
              call SndPack('Y',num,0)     !Acknowledge it
              call quit                   !Turn everything off
              call Logoff3                !and log off the session

          else                            !Other generic packet type?
              ErrMsg = 'Unknown generic packet type: ' // pt
              call kdebug(all,ErrMsg,' ')
              call SndErr
          endif

      else if (pt .eq. 'T') then          !Time-out?
          seq = 0                         !Reset the sequence number
          call SndPack('N',seq,0)         !Guard against lost packets
          goto 10                         !Ignore it

      else if (pt .ne. 'N') then          !Something other than NAK?
          ErrMsg = 'Unknown Server packet type: ' // pt
          call kdebug(all,ErrMsg,' ')
          call SndErr
      endif

      goto 10

      end

      logical*2 function Send()                          ,<890525.1144>
     >Send-state switch
      implicit none

      include kercom.ftni,NOLIST
      include kerdbg.ftni,NOLIST
      include kerfil.ftni,NOLIST
      include kersta.ftni,NOLIST
      integer*2 retry
      character*1 sdata,sfile,seof,sinit,sbreak
      character*3 c_r

      state = 'S'                         !Set initial state
      c_r = char(13) // ' _'
      fSend = .true.                      !Set Send/Receive flag for send
      send = .false.                      !Clear the success flag
      retry = 0                           !Reset the retry-counter
      call LoadSeg(2) $ call NextFile     !Get 1st file to send
      if (fiNm .eq. ' ') return           !Nothing to send
      call LoadSeg(3) $ call StartStats   !Prepare for packet-I/O

 10   if (state .eq. 'D') then            !Send data?
          state = sdata(retry)
      else if (state .eq. 'F') then       !Send file header?
          state = sfile(retry)
      else if (state .eq. 'Z') then       !Send EOF?
          state = seof(retry)             !Yes - send the packet
          if (state .eq. '@') then        !Ready for next file?
              call LoadSeg(2)             !Get the file-masking routines
              call NextFile               !Get next file to send
              call LoadSeg(3)             !Restore packet-I/O capability
              if (fiNm .eq. ' ') then     !Is there one?
                  state = 'B'             !No - break the connection
              else
                  state = 'F'             !Yes - do a file-header
              endif
          endif
      else if (state .eq. 'S') then       !Send initial packet?
          state = sinit(retry)
      else if (state .eq. 'B') then       !Send final packet?
          state = sbreak(retry)
      else if (state .eq. 'C') then       !Last file sent?
          call endstats                   !Turn off statistics logging
          send = .true.
          return
      else if (state .eq. 'E') then       !Did we receive an error packet?
          call endstats
          if (.not. fServ) call tpFm(ErrMsg)
          return
      else if (state .eq. '!') then       !Did we get an error?
          call endstats
          call SndErr
          return
      else                                !Unknown packet?
          call endstats
          ErrMsg = 'Send-state error; state = ' // state
          call kdebug(states,ErrMsg,' ')
          if (R .ne. L) then
              call tpFm(ErrMsg)
          endif
          call SndErr
          return
      endif

      call kdebug(states,'TxState: ',state)
      if (retry .ne. 0) rtry = rtry + 1
      if (R .ne. L) then
          call tpI2(c_r,spak,6)
          call tpI2('/_',rtry,-3)
          call tpFm(' _-')
      endif

      goto 10
      end

      subroutine sleep(csec)                             ,<890525.1144>
     >Delay for N centiseconds
      implicit none

      integer*2 csec,i

      if (csec .gt. 0) then               !Need negative units to wait
          i = -csec
      else
          i = -2                          !Always wait at least 2 units
      endif

      call exec(12,0,1,0,i)
c                ^ ^ ^ ^ ^
c                ! ! ! ! +----> number of units to delay
c                ! ! ! +------> repeat this how many times?" (none = 0)
c                ! ! +--------> Units are centiseconds
c                ! +----------> Suspend myself (not some other task)
c                +------------> Executive request code to suspend
c     In order to read the above diagram, read upwards:
c         "I want the executive to suspend me once for (csec) centiseconds,
c          and then I will do something else."

      return
      end

      block data main_common                             ,<890525.1144>
     >KERMIT's labeled common areas
      implicit none

      include kcmnds.ftni
      include kconcw.ftni
      include kercmd.ftni
      include kercnf.ftni
      include kercom.ftni
      include kerdbg.ftni
      include kerfil.ftni
      include kersta.ftni

      data Lsyu       /0/                 ! Insure 1st-time stuff is done

      data seg        /0/                 ! Insure 1st LoadSeg call works
      data delay      /1500/              ! 15 sec from SEND to 1st pkt
      data EsChar     /29/                ! CTRL-] returns to local KERMIT
      data MaxTry     /5/                 ! Normal retry-limit is 5
      data ImxTry     /15/                ! Initial retry-limit is 15
      data R          /0/                 ! Remote LU is unknown at startup
      data seq        /0/                 ! Sequence numbers starts at 0
      data Class      /0/                 ! We get a class# as needed
      data sPcnt      /9/                 ! I only have 9 parameters to send
      data Parity     /0/                 ! 'Not set yet'

! My packet parameters follow
      data PakSiz     /94/                ! Current packet size
      data Timeout    /0/                 ! (filled in by GetPakTime)
      data nPad       /0/                 ! I require no padding, but...
      data Padch      /0/                 !  ...use nulls if you must pad
      data EOLch      /13/                ! I require CR as a terminator
      data Quote      /35/                ! I want "#" before controls
      data Bit8       /38/                ! I want "&" before 8th-bit set
      data ChkTyp     /1/                 ! I do type-1 checksums
      data Repc       /126/               ! Repeat-count prefix is "~"
      data Sync       /1/                 ! CTRL-A starts my packets

! My partner's defaults are reset by subroutine RecPar to:
      data sPkSiz     /80/                ! Packet size
      data sTime      /30/                ! Timeout (never wait past 30 sec)
      data sPad       /0/                 ! I'll never send padding
      data sPadch     /0/                 ! (If I pad, I'll use nulls)
      data sEOL       /13/                ! <CR> is end-of-packet
      data sQuote     /35/                ! "#" precedes control-characters
      data sBit8      /32/                ! No 8th-bit quoting assumed
      data sCheck     /1/                 ! 1-byte checksums used
      data sRepc      /32/                ! No repeat-counts assumed
      data sSync      /1/                 ! CTRL-A starts your packets

! Utility defaults follow
      data fWarn      /.true./            ! I will warn of file overwrites
      data fIBM       /.false./           ! I am not in IBM mode
      data fServ      /.false./           ! I am not in server mode
      data fEcho      /.false./           ! I am not echoing transfer-file
      data fTrans     /.false./           ! I am not using a transfer-file
      data f8OK       /.true./            ! I will allow 8-th bit quoting
      data HlpNam     /' '/               ! I don't know the help file name

      data state      /'C'/               ! File-transfer is C(omplete)
      data Prompt     /'Kermit-RTE>'/     ! Command-line prompt

! File defaults follow
      data fBnry      /.false./           ! Assume ASCII transfers
      data Mask       /' '/               ! Set default (directory) mask
      data Rmask      /' '/               ! Clear the server-receive mask
      data fiNm       /' '/               ! Clear the file-name storage

! Debugging defaults follow
      data dbNm       /' '/               ! No debugging file opened
      data dbLv       /0/                 ! No debugging in progress

! Status stuff follows
      data tspak      /0/                 ! No packets sent yet     (total)
      data trpak      /0/                 ! No packets received yet (total)
      data trtry      /0/                 ! No retries yet          (total)
      data spak       /0/                 ! No packets sent yet     (current)
      data rpak       /0/                 ! No packets received yet (current)
      data rtry       /0/                 ! No retries yet          (current)
      data sbytes     /0/                 ! No bytes sent
      data rbytes     /0/                 ! No bytes received
      data sovrhd     /0/                 ! No overhead bytes sent
      data rovrhd     /0/                 ! No overhead bytes received

!     WARNING: The order of the pvalues must match the order of the parity
!              commands themselves in /KCMNDS/
!     Parity bits =  EVEN,   MARK,    NONE,    ODD,  SPACE
      data pvalu / 41400b, 41000b, 140000b, 40400b, 40000b,
     >             41400b, 40400b,      0b, 41000b, 40000b/

! Command constants follow
      data commands/
     >    'BYE',    'CONNECT', 'EXIT',    'FINISH', 'GET',
     >    'HELP',   'QUIT',    'RECEIVE', 'RUN',    'SEND',
     >    'SERVER', 'SET',     'SHOW',    'STATUS', 'TRANSFER'/
      data setparms/
     >    'BINARY', 'BQUOTE', 'CHECK',  'DEBUG',  'DELAY',  'ESCAPE',
     >    'IBM',    'LINE',   'PACKET', 'PARITY', 'PROMPT', 'QUOTE',
     >    'REPEAT', 'RETRY',  'RMASK',  'SYNC',   'WARNING'/
      data parits  / 'EVEN', 'MARK', 'NONE', 'ODD',     'SPACE'/
      data debugs  / 'ALL',  'FILE', 'OFF',  'PACKETS', 'STATES'/

      end
      program K1CMD(5)                                   ,<890525.1144>
     >KERMIT command processors
      implicit none

      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      include kercnf.ftni,NOLIST

$alias /datc/ = '$DATC', NoAllocate
$alias xla    = '.XLA', direct

      integer*2 datc,SyRv,xla
      common /datc/ datc

      seg = 1
      if (Lsyu .eq. 0) then               !Need to initialize?
          call GetMux(L,LocCnf)           !Get the local configuration
          SyRv = xla(datc)                !Get the system date-code

          call tpCh('HP-1000 RTE-KERMIT Version 1.99d <890525.1144>'
     >                                                ,char(10),0)
          call tpCh(' KERMIT-RTE requires EOL=13!',char(10),0)

          call HostMode                   !Check and/or change host mode
          fServ = .false.                 !Can't be serving on startup
          cmCh = ' '                      !Clear the command-line
          call getst(cmIn,-65,cmLn)       !Get a possible run-string

          if (SyRv .gt. 5010) then        !Newer than I know about?
              call tpFm('BEWARE - KERMIT has not been tested_')
              call tpFm(' under this system revision!')
          endif

          call SetTrap(SyRv)              !Set FORTRAN-traps as needed
      endif

      call SegRt

      end

      subroutine Command                                 ,<890525.1144>
     >Do user commands
      implicit none

      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      include kcmnds.ftni,NOLIST
      include kerdbg.ftni,NOLIST
      integer*2 i,err,xl(2),cw,FmpOpen,FmpRead,TrimLen,Match
      logical*2 MustBeLocal
      character*1 cmC1(80)
      equivalence (xl(2),cw),(cmC1,cmLn)
      data cw /400b/                      !Set Echo on terminal LU

      xl = L                              !Put LU into control-word

 10   if (fTrans) then                    !Getting transfer-file commands?
          cmCh = ' '                      !Yes - clear the command-line
          cmLn=FmpRead(trCb,err,cmIn,65)  !Yes - get one
          if (err.lt.0 .or. cmLn.lt.0) then  !On EOF or error...
              call FmpClose(trCb,fTrans)     !(don't destroy read-error)
              fTrans = .false.               !Turn off transfer-file flag
          endif
          if (err.lt.0) call ReportFileError(err,'<transfer-file>')
      endif

!     By first going to the transfer-file for a command and allowing zero-
!     length commands, I can perform a sort of 'return to the console'
!     operation FOR ONE COMMAND ONLY per blank line in in the transfer-
!     file.  If you find yourself at a console prompt unexpectedly, you
!     can make KERMIT go back to the transfer-file (without processing a
!     dummy command) by entering one or more commas only.

      cmLn = TrimLen(cmCh)
      if (cmLn .lt. 1) then
          fPkIO = .false.                 !Can't be in packet-I/O here
 20       call tpCh(Prompt,' _',0)        !Prompt the user
          call xreio(1,xl,cmIn,-65)       !get a command
          call abreg(i,cmLn)              !Get the input length
          cmCh(cmLn+1:) = ' '             !Clear unused part of command
          cmLn = TrimLen(cmCh)            !Now get the data length
          if (cmLn .lt. 1) goto 20        !Reprompt if none given
      endif

!     This is the top-level parser.  For a given top-level keyword, do the
!     function indicated.  Most commands can be (severely!) abbreviated.

      if (fEcho) call tpCh(' -',cmCh,0)   !Echo as directed
      call kdebug(all,'Command: ',cmCh)   !log the command
      cmRu = cmCh                         !Save for RunProgram/SetPrompt
      call CaseFold(cmCh)                 !Convert to upper case
      do i = 1,cmLn                       !Convert commas to blanks
          if (cmC1(i) .eq. ',') cmC1(i) = ' '
      enddo
      cmLn = TrimLen(cmCh)                !"Kill" trailing blanks
      if (cmLn .lt. 1) goto 10            !Ignore the current command
      cmP2 = 0                            !Initialize token search
      call gettok('?')                    !Locate a token

      i = match(commands,cmtsiz,0)        !Find the command in vocabulary
      if (cmTk .eq. '?') goto 30
      if (i .gt. 0) then                  !If in vocabulary...
          cmTk = commands(i)              !...expand the command token
      endif

!     In the "case" statement which follows, we only return after surviving
!     the parsing for commands which perform packet-I/O.

      if (cmTk .eq. 'BYE') then
          if ( MustBeLocal() ) return     !Only return if local-host
      else if (cmTk .eq. 'CONNECT') then
          call connect
      else if (cmTk.eq.'EXIT' .or. cmTk.eq.'QUIT') then
          call quit
          call exec(6)
      else if (cmTk .eq. 'FINISH') then
          if ( MustBeLocal() ) return     !Remote-host not allowed
      else if (cmTk .eq. 'GET') then
          if ( MustBeLocal() ) then
              call GetFile(*30)
              cmTk = 'GET'
              return
          endif
      else if (cmTk .eq. 'HELP') then
          call help
      else if (cmTk .eq. 'RECEIVE') then
          call RecFile(*30)
          cmTk = 'RECEIVE'
          return
      else if (cmTk .eq. 'SEND') then
          call SndFile(*30)               !Parse the command
          cmTk = 'SEND'
          return
      else if (cmTk .eq. 'SERVER') then
          call ServerInit(*30)            !Ok to go to server?
          cmTk = 'SERVER'
          return
      else if (cmTk .eq. 'SET') then
          call Set
      else if (cmTk .eq. 'SHOW') then
          call show
      else if (cmTk .eq. 'STATUS') then
          call status
      else if (cmTk .eq. 'TRANSFER') then
          if (fTrans) then
              call tpFm('Transfer-files may not be nested!')
          else
              call gettok(' ')            !Get transfer-file's name
              if (FmpOpen(trCb,err,cmTk,'ro',1) .gt. 0) then
                  fTrans = .true.
                  call gettok('NO')       !Default to no echo
                  fEcho = (cmTk(:2) .ne. 'NO')
              else
                  call FmpReportError(err,cmTk)
              endif
          endif
      else                                !If no token matches...
          call RunProgram                 !...assume it is a program name
      endif

 30   cmCh = ' '                          !Clear last command out
      goto 10                             !Get another command

      end

      subroutine HostMode                                ,<890525.1144>
     >Check host mode
      implicit none

      include kercom.ftni,NOLIST
      include kercnf.ftni,NOLIST          !Defines fRmx

      integer*2 bngdb,i
      character*5 rates(0:15)
      data rates/'????','50','75','110','134.5','150','300','1200',
     >           '1800','2400','4800','9600','19.2k','38.4k','115k',
     >           'sense'/

      if (R .eq. 0) then                  !Is remote lu undefined?
          R = L                           !Assume remote-host mode
          call MoveWords(LocCnf,RemCnf,CnfSiz) !local config -> remote array
      endif

      call tpFm('KERMIT-RTE is in _')
      call GetPakTimeout(i)               !Sense "remote" baud rate
      if (R .eq. L) then
          call tpFm('remote-host mode_')
          if (.not. fRmx) then
              call tpFm(', but not on a mux port')
              call tpFm('(You''ll need to SET LINE to some mux LU_')
              call tpFm(' before you can transfer files)')
              call tpFm(' "Server" is not available at this LU!')
          else
              call tpFm('; file transfers are ok')
              if (bngdb() .eq. 0) call lurq(100001b,L,1)
          endif
      else
          call tpI2('local-host mode to LU _',R,0)
          call tpCh(' @ _',rates(i))      !Show the baud rate
          call tpFm(' baud; _')
          call ShowParity
          call lurq(100001b,R,1)
      endif

      return
      end

      integer*2 function GetPakTimeout(i)                ,<890525.1144>
     >Get Packet-I/O timeout
      implicit none

      include kercom.ftni,NOLIST
      include kercnf.ftni,NOLIST
      integer*2 baudtimes(14),i,ixget

c     baud rate-->       50,   75,  110,134.5,  150,  300,  1200+
      data baudtimes / 2500, 1900, 1500, 1300, 1200,  900,  8*600 /

c     This routine sets my timeout value (in my parameter block) as a
c     function of the REMOTE's baud-rate.  It returns as it's parameter
c     the index to the baud-rate table, and as it's value the number of
c     100ths of a second to wait for a packet (from me) as follows:
c          the time required to receive 100 bytes at the given baud rate
c        + 1 second for any fractional second from the above
c        + 5 seconds for processing time.

c     NOTE: the remote KERMIT will tell me (in the SINIT packet) if I
c     should time-out a packet-receive; even if the remote KERMIT doesn't
c     want that processing, I'll still time-out a packet receive after
c     30 seconds.  Note that in any event, under RTE-A no receive-packet
c     timeouts will occur because the device driver must be bypassed.

      i = r30c                            !Get the current configuration
      i = iand(ishft(i,-3),17b)           !Isolate/right-justify rate
      if (i.lt.1 .or. i.gt.12) then       !Is it a legal value?
          i = 0                           !No - return "unknown"
          Timeout = 0                     !...and don't do timeouts
      else
          Timeout = baudtimes(i)/100      !Put in my parameter block
      endif

      GetPakTimeout = Timeout * 100       !Tell SERVER the timeout value

      return
      end

      subroutine ShowParity                              ,<890525.1144>
     >Show remote-port parity
      implicit none

      include kercom.ftni.NOLIST
      include kercnf.ftni.NOLIST
      include kcmnds.ftni.NOLIST
      integer*2 i,j,k,pmask,pvals(5,2)
      parameter (pmask = 141400b)         !Mask removes current parity bits
      equivalence (pvalu,pvals)

      i = r30c .and. pmask                !Isolate current parity bits
      j = (iRmx .and. 1) + 1              !Set pvalu index for B/C or D mux
      call tpFm(' Parity = _')
      do k = 1,prtsiz
          if (i .eq. pvals(k,j)) then
              call tpFm(parits(k))
              return
          endif
      enddo
      call tpFm(' Unknown!')

      return
      end

      logical function ctoi(rval)                        ,<890525.1144>
     >Parse ASCII to integer
      implicit none

c     This routine parses ASCII characters into a single 16-bit integer.
c     The character data may be in decimal, octal ("B" must be the last
c     byte), or hexadecimal ("H" must be the last byte), and may contain
c     a leading sign.  A character-literal may be entered as a number if
c     the other (last) character is a '"'.  CTOI returns false if no
c     numeric can be parsed due to no data or illegal data.  The
c     command-line pointer cmP2 is expected to point to the end of the
c     previous token on entry; cmP1 and cmP2 will point to the next
c     token on exit, or cmP1 will equal 0 if there are no more tokens
c     on the line.

      include kercmd.ftni,NOLIST
      integer*2 p,i,e,rval,base
      character*1 c,s

      ctoi = .false.                      !Show initial "no number found"
      rval = 0                            !...and clear the value save
      call gettok(' ')                    !Isolate the numeric
      if (cmP1 .lt. 1) return             !there isn't a number there

      e = cmP2                            !Save end pointer
      c = cmCh(e:e)                       !Get base character (if any)
      if (c .eq. 'B') then                !Is it octal?
          base = 8                        !Yes
          e = e - 1                       !Don't parse the "b"
      else if (c .eq. 'H') then           !No? try hexadecimal
          base = 16
          e = e - 1                       !Don't parse the "h"
      else if (c .eq. '"') then           !No? try ASCII literal
          if ( (cmP2-cmP1) .eq. 1) then   !(must be the literal, then a '"')
              c = cmCh(cmP1:cmP1)         !Get the character
              rval = ichar(c)             !Convert to integer
              ctoi = .true.
              return
          endif
      else                                !No? assume decimal
          base = 10
      endif

      p = cmP1                            !Save the starting pointer
      c = cmCh(p:p)                       !Get sign (if any)
      if (c.eq.'+' .or. c.eq.'-') then    !If there is a sign...
          p = p + 1                       !Bump the byte pointer
          s = c                           !...and save the sign byte
      else
          s = ' '
      endif

      do while (p .le. e)                 !Parse the number
          c = cmCh(p:p)                   !Get a byte
          p = p + 1                       !Bump the byte pointer
          i = ichar(c) - 60b              !Convert numerics to integer
          if (i .lt. 0) return            !non-numeric found
          if (i.gt.9) then                !Allow possible hex digits
              if (i.lt.17 .or. i.gt.22) return  !Insure it is 'A' thru 'F'
              i = i - 7                         !Scale hex digits
          endif
          if (i .ge. base) return         !Illegal byte for this base
          rval = (rval*base) + i          !Continue forming number
      end do

      ctoi = .true.
      if (s .eq. '-') rval = -rval        !Deal with a "-", if found
      return
      end

      subroutine gettok(default)                         ,<890525.1144>
     >Get a command-line token
      implicit none

c     This routine is sets cmP1 and cmP2 to the start and end of a "token"
c     (one or more non-blanks in the command line), and cmTk is set to the
c     token itself.  If there are no more tokens in the line, cmP1 returns
c     zero, cmP2 is undefined, and cmTk returns the "default" string.
c
c     NOTICE -- cmP1 is always set to cmP2+1 before use; to locate the
c     first token in a line you must set cmP2 to 0.  Locating the "next"
c     token on a line is automatic.

      include kercmd.ftni,NOLIST
      character*(*) default

      cmP1 = cmP2 + 1                     !Always go to next byte
      call skipbl(cmP1)                   !Skip leading blanks
      cmP2 = cmP1                         !We have start-of-token
      call skip2bl(cmP2)                  !go 1 past end-of-token
      cmP2 = cmP2 - 1                     !Back up to end-of-token
      if (cmP1 .gt. cmLn) then            !Are we past last token?
          cmP1 = 0                        !Yes - note it
          cmTk = default
      else
          cmTk = cmCh(cmP1:cmP2)
      endif

      return
      end

      integer*2 function match(tabl,tlen,dum)            ,<890525.1144>
     >Match token to token-table
      implicit none

      include kercmd.ftni,NOLIST
      include kercom.ftni,NOLIST
      character*(*) tabl(*)
      integer*2 tlen,dum
      logical*2 fCMMD                     !True for special COMMAND call
      character*1 tc
      integer*2 t1,t2,len,TrimLen

c     MATCH tries to locate the token (cmTK) in the TABLe of strings
c     containing TLEN entries.  If the token is found >uniquely< in
c     the table, the index of that entry is returned as the value of
c     MATCH; otherwise MATCH returns 0.  If the token contains a "?",
c     any table entries which were matched up to (but not including)
c     the "?" are printed on locally with an appropriate message.
c     In the absence of a "?", if more than one table entry matches
c     the token, MATCH returns as if there was no match and prints a
c     message to inform the user of ambiguous data and shows all of
c     the possible choices.
c
c     cmTk must not contain embedded blanks
c     TABL must be in alphabetical order

      fCMMD = pcount() .eq. 3             !True if special COMMAND call
      len = TrimLen(cmTk)                 !Get the token's length
      t1 = 1                              !Set current low table index
      t2 = tlen                           !Set current high index
      p = 1                               !Set token byte-pointer
      match = 0                           !Show no match initially

      do while (p .le. len)               !Begin matching here
          tc = cmTk(p:p)                  !Get a token character
          if (tc .eq. '?') then           !If "?" then give possibilities
              call tpFm('The following are legal at this point:')
              call outtbl(tabl,t1,t2)
              return
          endif

c         (do while token is less than lower table entry)
          do while (tc.gt.tabl(t1)(p:p) .and. t1.le.t2)
              t1 = t1 + 1
          enddo

c         (do while token is greater than upper table entry)
          do while (tc.lt.tabl(t2)(p:p) .and. t2.ge.t1)
              t2 = t2 - 1
          enddo

c         (if we know we have a mismatch...)
          if (t2 .lt. t1) then
              if ( fCMMD ) return
              call tpCh('No such command or parameter -',cmTk(:len),0)
              call tpFm('The following are legal at this point:')
              call outtbl(tabl,1,tlen)
              return
          endif

          p = p + 1                       !Bump the token byte-pointer

      enddo

c     After scanning all of the token, is it still ambiguous?

      if (T1 .ne. T2) then
          if ( fCMMD ) return
          call tpCh('"_',cmTk,len)
          call tpFm('" is ambiguous; possible matches are:')
          call outtbl(tabl,t1,t2)
      else
          match = t1
          cmTk = tabl(t1)                 !Expand the token
      endif

      return
      end

      subroutine outtbl(tabl,t1,t2)                      ,<890525.1144>
     >Print strings (tabular)
      implicit none

      character*(*) tabl(*)
      integer*2 t1,t2
      integer*2 cwid,ncol,i,j,k

c     This routine prints strings in a table (TAB) from indexes T1 to T2

      cwid = len(tabl(1))                 !Get the column width
      ncol = 80 / (cwid + 2)              !Get # of displayable columns

      do i = t1,t2,ncol                   !Output the columns
          do j = 1,ncol                   !print each table entry
              k = i + j - 1
              if (k .le. t2) then
                  call tpCh(' _',tabl(k),cwid)
                  if (j .lt. ncol) call tpFm(' _')
              endif
          enddo
          call tpFm('-')
      enddo

      return
      end

      subroutine connect                                 ,<890525.1144>
     >Do terminal-emulation
      implicit none

      include kconcw.ftni,NOLIST          !Defines XLUEX ConWords + term
      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      include kercnf.ftni,NOLIST
      include kerdbg.ftni,NOLIST
      integer*2 ib(128),il                !The input buffer & its length
      integer*2 k,a,b,gtnw                !Various temporaries
      logical*2 eflag                     !TRUE if escape-char processed
      logical*2 NeedRTerm                 !TRUE if Remote needs termination
      logical*2 ifbrk,SetLine,MustBeLocal

      k = cmP2                            !Save current parsing pointer
      call GetTok('none')                 !See if there is another parameter
      if (cmTk .ne. 'none') then          !If so, do Set Line for the user
          cmP2 = k                        !Restore the parsing pointer
          cmTk = 'CONNECT'                !...and the "current" command
          if (.not. SetLine() ) return    !The set line didn't work
      endif

      if (.not. MustBeLocal() ) return    !User hasn't Set Line yet

      eflag = .false.                     !No escape-char seen yet
      fASI = .not. fLmx                   !Set for Local ASIC-type card
      fRcm = .not. btest(iRmx,0)          !Note if remote uses B/C mux
      fLcm = .not. btest(iLmx,0)          !Note if local uses B/C mux
      if (class .eq. 0) then              !Do we need a class number?
          call clrq(100001b,class)        !Yes - get one
          call abreg(a,b)                 !Get return status
          if (a .lt. 0) then              !Did we get a class # ?
              call tpFm('Cannot connect: no class numbers available')
              return
          else
              class = ior(class,20000b)   !Set "don't de-allocate" bit
          endif
      endif

!     (Since GtNW is not in common, we must set it here)
      gtnw = ior(class,100000b)           !Set no-wait bit

      call cPrep                          !Prepare ports for connect-mode

      call tpI2('[connecting to LU _',R,0)
      call tpFm('; return via "control-_')
      call tpCh(char(EsChar+64),'" then "C"]',0)

      if ( fASI ) then                    !Non-mux local does class I/O
          call xluex(17,Lrx,ib,-1,0,0,class)  !Start local read
      endif
      if ( fRcm ) NeedRTerm = .true.      !Terminate 1st B/C mux buffer

!     The connect loop consists of an inner polling-loop and the outer
!     processing-loop as follows:
!         The inner polling-loop interrogates the remote status looking
!             for availability of type-ahead data, and the local keyboard
!             (via a no-wait class "get" call, or, if on a mux, when some
!             typed-ahead data becomes available) until one of them shows
!             data available, or until the break-flag is set (which will
!             simulate the user typing <escape-character>"C" to close the
!             connection.  Processing of remote data is handled within
!             the inner-loop; we exit the inner-loop on receipt of any
!             keyboard data or if another user "breaks" this KERMIT.
!         The outer processing-loop has two major divisions: the polling
!             loop, and local data-handling, which must be checked on a
!             character-by-character basis for the presence of the escape
!             character.  An escape character signals the beginning of a
!             user command to (the local) KERMIT.
!
!     The flow of this code is sufficiently complicated that I have elected
!     to use (gasp!) a few statement numbers rather than the more elegant
!     (and more cumbersome) if-then-else and unnumbered do-while constructs
!     found in previous versions of this routine.
!
!     I am indebted to Bruce K. Swope, of Intermedics, Inc. in Freeport,
!     Texas, for his assistance in locating the cause of the "mux lockup".
!     His ideas on the handling of the remote port have resulted in greatly
!     reducing (if not completely eliminating) occurrences of this dreaded
!     condition.
!
!     "D" mux handling notes: as you can probably see from the code, the
!     12040D handles much nicer than the B or C revisions (can't wait for
!     the M/E/F version!).  The card can buffer up to 1024 bytes, but I
!     don't want to tie up that much memory; I have elected to never read
!     more than 256 bytes from remote port at any given time.

 10   do while (.true.)                   !inner-loop begins
          if (NeedRTerm) then             !Need to terminate remote?
              call control(R,term,0)      !Yes - do it, but not more than
              NeedRTerm = .false.         !...once per input buffer
          endif
          call sleep(4)                   !Let other folks run for 40 ms.
          if ( IfBrk(k) ) goto 40         !Proceed as if "<esc>C" entered
          if ( fLmx ) then                !Local on mux?
              call control(L,dstat,0)     !Yes - get local status
              call abreg(a,il)
              if (il .gt. 0) then         !Any data available?
                  call xluex(1,Lrx,ib,-1) !Yes - get only 1 byte...
                  if ( fLcm ) then        !For local B/C mux...
                      call control(L,term,0)  !...re-terminate input
                  endif
                  il = 1 $ goto 20        !...and process it
              endif
          else
              call exec(21,gtnw,ib,-1)    !Look for keyboard data
              call abreg(a,il)            !Get the status
              if (a .gt. 0) goto 20       !Keyboard data is available
          endif
          call control(R,dstat,0)         !Request remote status
          call abreg(a,il)                !Get it back from driver
          if (il .gt. 0) then             !Data available?
              il = min(il,256)            !Limit input to 256 bytes
              call xluex(1,Rrx,ib,-il)    !Yes - get it
              if ( fLmx ) then            !Local on a mux?
                  call xluex(2,Ltx,ib,-il)   !Yes - just write
              else
                  call clrq(3,class,L)       !Abort pending keyboard read
                  call xluex(2,Ltx,ib,-il)   !Copy remote data to display
                  call xluex(17,Lrx,ib,-1,0,0,class)  !Set new keyboard read
              endif
              if ( fRcm ) then            !Terminate remote on next pass...
                  NeedRTerm = .true.      !...if using B or C mux
              endif
          endif
      end do

 20   if (il .le. 0) goto 30              !(Ignore keyboard timeout)

      if (fIBM) call xluex(2,Ltx,ib,-1)   !Do local echo as needed
      k = ishft(ib,-8)                    !Get the local keystroke
      if (k.gt.140b .and. k.lt.172b) k=k-40b   !Shift to upper-case

      if (k .eq. EsChar) then             !Escape?
          eflag = (.not. eflag)           !Yes - toggle the escape flag
          if (eflag) il = 0               !Send if previous was escape
      else if (eflag) then                !If last keypress was escape...
          il = 0                          !say "don't send this"
          eflag = .false.                 !turn off escape flag
          if (k .eq. 103b) then           !'C' or 'c': close the connection
              goto 40
          else if (k .eq. 122b) then      !'R' or 'r': resume debug logging
              dblv = iand(dblv,77777b)
          else if (k .eq. 123b) then      !'S' or 's': stop debug logging
              dblv = ior(dblv,100000b)
          else if (k .eq. 63) then        !'?': help
              call tpFm('        C         = Close the connection')
              call tpFm('        R         = Resume debug logging')
              call tpFm('        S         = Suspend debug logging')
              call tpCh('control-_',char(eschar+64),0)
              call tpFm(' (again) = send escape to remote')
              eflag = .true.
          else
              call tpFm('Unknown escape function')
          endif
      endif

      if (il .gt. 0) then                 !Anything left to send?
          call xluex(2,Rtx,ib,-1)         !Send keystroke to remote
      endif

 30   if ( fASI ) then                    !reset local (non-mux) read
          call xluex(17,Lrx,ib,-1,0,0,class)
      endif
      goto 10                             !keep looping

 40   if ( fASI ) then                    !Do non-mux local cleanup
          call clrq(3,class,L)            !Clear pending local requests
          a = 0                           !Prepare to kill completed reqs
          do while (a .ge. 0)
              call exec(21,gtnw,ib,-1)    !Get any completed requests
              call abreg(a,il)
          enddo
      elseif ( fLcm ) then                !Cleanup from local B/C mux?
          call control(L,3700b,102000b)   !Yes (RESTORE does the rest
      endif
      if ( fRcm ) then                    !Restore from B/C connect
          call control(R,3300b,22500b)    !cn33: read reconfig on
          call control(R,3700b,102000b)   !cn37: terminate on CR only
      endif
      call control(R,2600b,1)             !cn26: clear (all) card buffers
      call restore(L)                     !Restore local parameters
      call enable(L,fLmx)                 !Restore int scheduling
      call tpFm('[back at KERMIT-RTE]')
      return

      end

      subroutine help                                    ,<890525.1144>
     >Process HELP commands
      implicit none

      include kcmnds.ftni,NOLIST
      include kercmd.ftni,NOLIST
      include kercom.ftni,NOLIST
      integer*2 i,match,err,o
      integer*2 TrimLen,FmpOpen,FmpSetPosition,FmpRead
      integer*4 cr,nr,OldP,CurP,NxtP,DoPos
      logical*2 fExist

      integer*2 hfCb(16)                  !Help-file control block
      integer*2 hBuf(128),hInd(18,7)      !Help-file record buffer
      character*256 hStr
      character*36  hKey(7)               !Help-file key entries
      character*24  TheKey
      equivalence (hBuf(3),hInd,hKey),(hBuf,hStr)

!     Statement function -- encodes rec# and offset into a double-integer
      DoPos(cr,o) = ishft(cr,8) + iand(o,377b)

      call gettok('HELP')                 !Set pointers to 2nd parameter

      i = match(commands,cmtsiz)
      if (i .lt. 1) return                !Just drop invalid commands
      if (cmTk .eq. 'SET') then       !Since SET has parameters...
          call gettok('<')            !...parse the 3rd parameter
          if (cmTk .ne. '<') then     !If it wasn't defaulted...
              i = match(setparms,setsiz)  !...expand the keyword
              if (i .lt. 1) return    !Drop an unknown set parameter
          endif
      endif

      if (HlpNam .eq. ' ') then           !Have we found the help file?
          if (fExist('kermit.hlp::system',1)) then   !No - try system dir
              HlpNam = 'kermit.hlp::system'
          else if (fExist('kermit.hlp::kermit',1)) then   !then KERMIT's dir
              HlpNam = 'kermit.hlp::kermit'
          else if (fExist('kermit.hlp',1)) then      !Then user's dir
              HlpNam = 'kermit.hlp'
          else if (fExist('"kermi::0',1)) then       !Last, try FMGR space
              HlpNam = '"kermi::0'
          else
              call tpFm('KERMIT.HLP missing or wrong file-type')
              return
          endif
      endif

      i = TrimLen(cmTk)                   !Clean up the key
      if (FmpOpen(hfCb,err,HlpNam,'ro',1).lt.0) then
          call ReportFileError(err,HlpNam)
      endif
      if (FmpRead(hfCb,err,hBuf,256).lt.0) then  !Read 1st record
          call FmpClose(hfCb,i)
          call ReportFileError(err,HlpNam)
      endif
      OldP = DoPos(0J,0)                  !Set previous position
      cr = 1                              !Note current record#...
      nr = 1                              !...and desired ("new") record
      o = 1                               !...and current offset
      CurP = DoPos(cr,o)                  !Save "current" position
      NxtP = DoPos(nr,o)                  !Save "next" position

 10   if (NxtP .eq. OldP) then            !In an endless loop?
          call tpFm('Sorry, no help available')  !Yes: kill endless loop
          return
      else
          OldP = CurP                     !Else save where we've been
          CurP = NxtP
      endif
      if (nr .ne. cr) then                !At correct file position?
          if (cr .ne. 0) then             !Handle 1st record after open
              if (FmpSetPosition(hfCb,err,nr,-nr).lt.0) then
                  call FmpClose(hfCb,i)
                  call ReportFileError(err,HlpNam)
              endif
          endif
          if (FmpRead(hfCb,err,hBuf,256).lt.0) then
              call FmpClose(hfCb,i)
              call ReportFileError(err,HlpNam)
          endif
          cr = nr                         !Note new current position
      endif
      TheKey = hKey(o)
      if (cmTk .lt. TheKey(:i)) then      !Current token too high?
          nr = hInd(15,o)                 !Get new record
          o  = hInd(16,o)                 !...and new offset
      else if (cmTk .gt. TheKey(:i)) then !Current token too low?
          nr = hInd(17,o)
          o  = hInd(18,o)
      else                                !Found the key, so...
          nr = hInd(13,o)                 !...get the text rec#
          o  = hInd(14,o)                 !...and char offset
          goto 20
      endif
      NxtP = DoPos(nr,o)                  !Build next-position value
      goto 10                             !Look some more

 20   if (FmpSetPosition(hfCb,err,nr,-nr).lt.0) then
          call FmpClose(hfCb,i)
          call ReportFileError(err,HlpNam)
      endif
      if (FmpRead(hfCb,err,hBuf,256).lt.0) then
          call FmpClose(hfCb,i)
          call ReportFileError(err,HlpNam)
      endif
      i = index(hStr(o:),char(4)) - 1     !Locate possible terminator
      if (i .lt. 1) then                  !No terminator yet
          call tpCh(hStr(o:) // '-','_',0)!Print the record
          o = 1                           !...reset the offset
          nr = nr + 1                     !...and go on to next record
          goto 20
      else
          i = i + o
          call tpFm(hStr(o:i))
      endif

 999  call FmpClose(hfCb,err)

      return
      end

      logical*2 function fExist(name,type)               ,<890525.1144>
     >Flag file existence and type
      implicit none

      character*(*) name
      integer*2     type,ActType

c     This routine returns .true. if the named file exists with the
c     given file-type.  If the file-type is given as a number less
c     than zero, the type-checking is omitted, and fExist returns
c     true if the named file exists as any file type

      include kercom.ftni,NOLIST
      integer*2 err,FmpOpen,hfCb(16)

      ActType = FmpOpen(hfCb,err,name,'ro',1)
      call FmpClose(hfCb,err)
      if (type .ge. 0) then
          fExist = (type .eq. ActType)
      else
          fExist = (ActType .ge. 0)
      endif

      return
      end

      subroutine Set                                     ,<890525.1144>
     >Parse/Perform SET commands
      implicit none

      include kcmnds.ftni,NOLIST
      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      include kerfil.ftni,NOLIST
      integer*2 i,match

      call gettok('?')                    !Isolate the parameter name
      i = match(setparms,setsiz)
      if (i .lt. 1) then                  !Just return on invalid choice
          return
      else
          cmTk = setparms(i)
      endif

      if (cmTk .eq. 'BINARY') then
          call Tok_On_True(fBnry)
          if (fBnry .and. Parity.ne.3 .and. .not.f8OK) then
              fBnry = .false.
              call tpFm('Can''t do binary transfers')
          endif
      else if (cmTk .eq. 'BQUOTE') then
          call SetBQuote
      else if (cmTk .eq. 'CHECK') then
          call SetCheck
      else if (cmTk .eq. 'DEBUG') then
          call SetDebug
      else if (cmTk .eq. 'DELAY') then
          call SetDelay
      else if (cmTk .eq. 'ESCAPE') then
          call SetEscape
      else if (cmTk .eq. 'IBM') then
          if (R .eq. L) then
              call tpFm('SET IBM is illegal in remote-host mode')
          else
              call Tok_On_True(fIBM)
          endif
      else if (cmTk .eq. 'LINE') then
          call SetLine
      else if (cmTk .eq. 'PACKET') then
          call SetPacket
      else if (cmTk .eq. 'PARITY') then
          call SetParity
      else if (cmTk .eq. 'PROMPT') then
          call SetPrompt
      else if (cmTk .eq. 'QUOTE') then
          call SetQuote
      else if (cmTk .eq. 'REPEAT') then
          call SetRepeat
      else if (cmTk .eq. 'RETRY') then
          call SetRetry
      else if (cmTk .eq. 'RMASK') then
          call gettok(' ')                !Get the server-receive mask
          rmask = cmTk
      else if (cmTk .eq. 'SYNC') then
          call SetSync
      else if (cmTk .eq. 'WARNING') then
          call Tok_On_True(fWarn)
      endif

      return
      end

      subroutine show                                    ,<890525.1144>
     >Process SHOW command
      implicit none

      include kercom.ftni,NOLIST
      include kerdbg.ftni,NOLIST
      include kerfil.ftni,NOLIST          !To define fBnry

      call HostMode                       !Show who's boss

      if (R .ne. L) then                  !we're in local-host mode
          call tpCh('ESCAPE character is ^-',char(eschar+64),1)
          call tpFm('IBM flag is_')
          if (fIBM) then
              call tpFm(' ON; prompt char is DC1')
          else
              call tpFm(' OFF')
          endif
      endif

      call tpFm('Binary transfers are_')
      if (fBnry) then
          call tpFm(' enabled')
      else
          call tpFm(' disabled')
      endif
      call tpFm('Receiving a duplicate file will be_')
      if (fWarn) then
          call tpFm(' aborted')
      else
          call tpFm(' allowed')
      endif
      call tpI2('File-send delay (seconds) = -',delay/100,0)
      call tpI2('Checksum type is -',ChkTyp,0)
      call tpI2('PACKET size is -',paksiz,0)
      call tpCh('QUOTE is -',char(quote),1)
      if ( f8OK ) then
          call tpCh('BQUOTE is -',char(Bit8),1)
      else
          call tpFm('Binary quoting is disabled')
      endif
      call tpCh('REPEAT is -',char(Repc),1)
      call tpCh('SYNC is ^-',char(sync+64),1)
      call tpCh('File transfer-state is -',state,1)
      if (dbNm .eq. ' ') then
          call tpFm('The debug log-file is undefined; not debugging')
      else if (dbLv .eq. 0) then
          call tpCh('Nothing is being debug-logged to -',dbNm,0)
      else if (dbLv .eq. ALL) then
          call tpCh('Everything is being debug-logged to -',dbNm,0)
      else if (dbLv .eq. STATES) then
          call tpCh('States are being debug-logged to -',dbNm,0)
      else if (dbLv .eq. PACKETS) then
          call tpCh('Packets are being debug-logged to -',dbNm,0)
      endif

      return
      end

      subroutine status                                  ,<890525.1144>
     >Give transmission statistics
      implicit none

      include kercom.ftni,NOLIST
      include kersta.ftni,NOLIST
      integer*4 time,baud,tbytes,work
      integer*2 hr,min,sec

      work = tspak + trpak
      call tpCh(char(10),'Statistics since startup:',0)
      call tpI2(' Packets sent =_',tspak,7)
      call tpI2(' Packets received =_',trpak,7)
      call tpI4(' Total packets =',work,9)
      call tpI2('  (_',trtry,0)
      call tpFm(' of the total were retries)')

      time = endtim - startim             !How long did it take (seconds)
      hr = time/3600                      !Get time in hours
      time = time - hr * 3600             !Remove hours from the time
      min = time/60                       !Get time in minutes
      sec = time - min * 60               !...and in seconds
      call tpCh(char(10),'Statistics of last transfer:',0)
      call tpI2(' Transfer time (hh:mm:ss) =_',hr,3)
      call tpI2(':_',min,-2)
      call tpI2(':',sec,-2)
      call tpI4(' Avg tx-packet size =_',sbytes/spak,3)
      call tpI4('  Avg rx-packet size =',rbytes/rpak,3)

      work = spak + rpak
      call tpI2(' Packets sent =_',spak,7)
      call tpI2(' Packets received =_',rpak,7)
      call tpI4(' Total packets =',work,9)
      call tpI2('  (_',rtry,0)
      call tpFm(' of the total were retries)')

      work = sbytes + rbytes
      call tpI4(' Bytes sent =_',sbytes,9)
      call tpI4(' Bytes received =_',rbytes,9)
      call tpI4(' Total bytes =',work,11)

      work = sovrhd + rovrhd
      call tpI4(' Send overhead (bytes) =_',sovrhd,9)
      call tpI4(' Receive overhead (bytes) =',rovrhd,9)
      call tpI4('  Total overhead (bytes) =',work,0)

      time = endtim - startim
      work = (sbytes + rbytes) / time
      call tpI4(' Total bytes per second: -',work,0)

      work = ( (sbytes+rbytes) - (sovrhd+rovrhd) ) / time * 10
      call tpI4('    Effective baud rate: -',work,0)

      return
      end

$alias lurq, NOABORT
      subroutine RunProgram                              ,<890525.1144>
     >Process RUN command
      implicit none

      include kcmnds.ftni,NOLIST
      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      integer*2 prams(5),err,FmpRunProgram,TrimLen
      character*5 RunName

      if (cmTk .eq. 'RUN') then
          call GetTok('!')                !See if a program name was given
      endif
      if (cmTk .eq. '!') then
          call tpFm('Usage: [ru ]program [params...]')
      else
          call lurq(40000b,L,1,*10)       !Allow other progs to use this LU
 10       err = FmpRunProgram(cmRu,prams,RunName)
          if (err .lt. 0) then
              if (err .eq. -6) then
                  call match(commands,CmtSiz)
              else
                  call FmpReportError(err,cmTk)
              endif
          else
              call exec(14,1,cmIn,-78)    !Get possible run-string
              call abreg(err,cmLn)        !Get length of that run-string
              if (err .ne. 0) then        !Was a string returned?
                  cmLn = 0                !No - clear the length return
              else
                  cmLn = min(TrimLen(cmCh),cmLn)
              endif
              if (cmLn.gt.0 .or. prams.ne.0) then
                  call tpCh('"_',RunName)
                  call tpFm('" has returned the following _')
                  if (cmLn .gt. 0) then
                      call tpFm('string:')
                      call tpFm('  '//cmCh(:cmLn))
                      if (prams.ne.0) call tpFm('and the following _')
                  endif
                  call tpFm('parameters (decimal):')
                  if (prams .ne. 0) then
                      do err = 1,5
                          call tpI2('  _',prams(err),6)
                      end do
                  endif
                  call tpFm(' -')         !Can't send all blanks to tpFm
              endif
              call HostMode               !Re-assert locks as needed
          endif
      endif

      return
      end

      subroutine SetDebug()                              ,<890525.1144>
     >Process SET DEBUG commands
      implicit none

      include kcmnds.ftni,NOLIST
      include kercmd.ftni,NOLIST
      include kercom.ftni,NOLIST
      include kerdbg.ftni,NOLIST
      integer*2 match,i,err,FmpOpen,FmpSetEof,DcbOpen

      call gettok('?')                    !Locate the next token
      i = match(debugs,dbtsiz)
      if (i .lt. 1) return                !Ignore bad parameter

      if (cmTk .eq. 'FILE') then
          dbLv = 0                        !Changing the file turns it off
          if (dbNm .ne. ' ') then
              call FmpClose(dbCb,err)
              dbNm = ' '
          endif
          call gettok(' ')                !Get the file-name pointers
          if (cmP1 .lt. 1) then           !None supplied?
              call tpFm('Usage: SET DEBUG FILE <file-name>')
              return
          endif
          dbNm = cmTk                     !Get the name
          if (FmpOpen(dbCb,err,dbNm,'wco',1) .lt. 0) then
              dbNm = ' '
              call ReportFileError(err,dbNm)   !(error on open - tell user)
          endif
          if (FmpSetEof(dbCb,err) .lt. 0) then   !Insure we can write
              call FmpClose(dbCb,err)
              dbNm = ' '
              call ReportFileError(err,dbNm)
          else
              call FmpRewind(dbCb,err)
              return
          endif
      endif

      if (DcbOpen(dbCb,err) .ne. 0) then  !Is debug file open?
          call tpFm('You need to SET DEBUG FILE <file-name> first')
      else if (cmTk .eq. 'ALL') then
          dbLv = ALL
      else if (cmTk .eq. 'STATES') then
          dbLv = STATES
      else if (cmTk .eq. 'PACKETS') then
          dbLv = PACKETS
      else if (cmTk .eq. 'OFF') then
          dbLv = 0
      endif

      return
      end

      subroutine SetDelay                                ,<890525.1144>
     >Process SET DELAY command
      implicit none

      include kercom.ftni,NOLIST
      integer*2 i
      logical*2 ctoi

      if (R .ne. L) then
          call tpFm('Set Delay is invalid in Local Host mode')
      else
          if (ctoi(i)) then
              if (i .lt. 0) then
                  call tpFm('Invalid delay value')
              else if (i .gt. 30) then
                  call tpFm('Value too big; using 30 seconds')
                  delay = 3000
              else
                  delay = i * 100
              endif
          else
              call tpFm('Usage: SET DELAY <value from 1 to 30>')
          endif
      endif
      return
      end

      subroutine SetEscape                               ,<890525.1144>
     >Process SET ESCAPE command
      implicit none

      include kercom.ftni,NOLIST
      integer*2 i
      logical*2 ctoi

      if (R .eq. L) then
          call tpFm('SET ESCAPE is invalid in Remote Host mode')
      else
          if (.not. ctoi(i)) then
              call tpFm('Usage: SET ESCAPE <control-character code>')
          else if (i.gt.0 .and. i.lt.32) then
              eschar = i
          else
              call tpFm('The escape must a control character')
          endif
      endif

      return
      end

      Logical*2 function SetLine()                       ,<890525.1144>
     >Process SET LINE command
      implicit none

      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      include kercnf.ftni,NOLIST
      integer*2 rmtlu,lutru,p30val,p30add,idadd,user(3),lu,sylu
      character*6 cUser
      character*1 CmdSav
      integer*2 WhoLockedLu,bngdb
      logical*2 ctoi
      equivalence (cUser,user)

      CmdSav = CmTk                       !Save 1st command character
      SetLine = .false.                   !"abort" command on error condition
      call lurq(100000b)                  !Clear all locks
      if (.not. ctoi(rmtlu)) then         !Get the LU# parameter
          if (CmdSav .eq. 'C') then       !Called from CONNECT?
              call tpFm('Usage: CONNECT [<logical unit #>]')
          else
              call tpFm('Usage: SET LINE <logical unit #>')
          endif
          goto 10
      endif

      sylu = lutru(rmtlu)                 !Get the system LU equivalent
      if (sylu .lt. 1) then               !In user's session?
          call tpFm('That LU is not in your session')
          goto 10
      endif

      if (R .ne. L) then                  !If switching remote lu's...
          call control(R,2600b,1)
          call restore(R)                 !Restore old configuration
          call enable(R,fRmx)
          R = 0
      endif

      if (lutru(L) .ne. sylu) then
          R = rmtlu                       !Set new remote-LU
          call lurq(100001b,R,1)          !Try to lock it
          call abreg(idadd,lu)            !Get return status from lock
          if (idadd .ne. 0) then          !Were we successful?
              idadd = WhoLockedLu(sylu)   !No - find out who has it
              call IdAddToName(idadd,user,lu)
              call tpI2('LU _',R,0)
              call tpCh(' is locked to _',cUser,0)
              call tpI2('/_',lu,0)
              call tpFm(' ...Sorry Charlie')
              R = 0
              goto 10
          endif
          call GetMux(R,RemCnf)           !Get its configuration
          if (.not. fRmx) then            !Is the LU on a mux?
              call tpFm('That LU is not on a mux')
              R = 0
          else if (r30c .eq. 0) then      !Has the port been configured?
              call tpFm('That LU has never been configured')
              R = 0
          else
              call disable(R,fRmx)        !Kill remote interrupt-scheduling
              call KillEnqAck             !Disable ENQ/ACK as needed
              SetLine = .true.            !OK to continue a Connect...
          endif
      endif

 10   call HostMode

      return
      end

      subroutine SetParity                               ,<890525.1144>
     >Process SET PARITY command
      implicit none

      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      include kcmnds.ftni,NOLIST
      include kercnf.ftni,NOLIST
      include kerfil.ftni,NOLIST          !To define fBnry

      integer*2 i,j,match,pmask,ixget,pvals(5,2)
      logical*2 MustBeLocal
      parameter (pmask = 36377b)          !Mask removes current parity bits
      equivalence (pvalu,pvals)

      if (.not. MustBeLocal() ) return    !Can't be remote

      call gettok('?')                    !Get the parity type requested
      i = match(parits,prtsiz)            !Do we recognize it?
      if (i .lt. 1) return
      Parity = i                          !Set B-quoting as needed
      r30c = r30c .and. pmask             !Get configuration w/o parity
      j = (iRmx .and. 1) + 1              !Set pvals index
      r30c = r30c .or. pvals(i,j)         !Plug in desired parity
      call control(R,3000b,r30c)          !Send it to the card
      call sleep(100)                     !Let the card catch up (?)
      call ShowParity                     !Show the changed parity

      if (parity.ne.3 .and. fBnry .and. .not.f8OK) then
          call tpFm('Can''t do binary transfers')
          fBnry = .false.
      endif

      return
      end

      subroutine SetPacket                               ,<890525.1144>
     >Process SET PACKET command
      implicit none

      include kercom.ftni,NOLIST
      integer*2 i
      logical*2 ctoi

      if (ctoi(i)) then
          if (i.gt.30 .and. i.lt.95) then
              PakSiz = i
          else
              call tpFm('Packet Size must be from 31 to 94')
          endif
      else
          call tpFm('Usage: SET PACKET <number from 31 to 94>')
      endif

      return
      end

      subroutine SetCheck                                ,<890525.1144>
     >Process SET CHECK command
      implicit none

      include kercom.ftni,NOLIST
      integer*2 i
      logical*2 ctoi

      if (ctoi(i)) then
          if (i.gt.0 .and. i.lt.4) then
              ChkTyp = i
          else
              call tpFm('Checksum type must be from 1 to 3')
          endif
      else
          call tpFm('Usage: SET CHECK <number from 1 to 3>')
      endif

      return
      end

      subroutine SetPrompt                               ,<890525.1144>
     >Process SET PROMPT command
      implicit none

      include kercmd.ftni,NOLIST
      include kercom.ftni,NOLIST

      call gettok('Kermit-RTE>')          !Set default
      if (cmP1 .ne. 0) then               !Was new prompt given?
          Prompt = cmRu(cmP1:cmP2)        !Yes - retrieve from original line
      else
          Prompt = CmTk                   !Else retrieve the default prompt
      endif

      return

      end

      subroutine SetQuote                                ,<890525.1144>
     >Process SET QUOTE command
      implicit none

      include kercom.ftni,NOLIST
      integer*2 i
      logical*2 ctoi

      if (ctoi(i)) then
          if (i.gt.32 .and. i.lt.127) then
              if (i .eq. Bit8) then
                  call tpFm('Invalid: conflicts with BQUOTE')
              else if (i .eq. Repc) then
                  call tpFm('Invalid: conflicts with REPEAT')
              else
                  Quote = i
              endif
          else
              call tpFm('Invalid: value must be from 33 to 126')
          endif
      else
          call tpFm('Usage: SET QUOTE <number from 33 to 126>')
      endif

      return
      end

      subroutine SetBQuote                               ,<890525.1144>
     >Process SET BQUOTE command
      implicit none

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST          !To define fBnry
      integer*2 i
      logical*2 ctoi

      if (ctoi(i)) then
          if ( (i.gt.31 .and. i.lt.63) .or.
     >         (i.gt.95 .and. i.lt.127) ) then
              if (i .eq. Quote) then
                  call tpFm(' Invalid: conflicts with QUOTE')
              else if (i .eq. Repc) then
                  call tpFm(' Invalid: conflicts with REPEAT')
              else
                  Bit8 = i
                  f8OK = Bit8 .ne. 32     !.true. if 8th-bit quote enabled
                  if (.not. f8OK) then    !Did they turn it on?
                      if (fBnry .and. Parity.ne.3) then  !Can we do binary?
                          fBnry = .false.
                          call tpFm('Can''t do binary transfers')
                      endif
                  endif
              endif
          else
              call tpFm('Invalid: value must be 32-62 or 96-126')
          endif
      else
          call tpFm('Usage: SET BQUOTE <value (32-62 or 96-126)>')
      endif

      return
      end

      subroutine SetRepeat                               ,<890525.1144>
     >Process SET REPEAT command
      implicit none

      include kercom.ftni,NOLIST
      integer*2 i
      logical*2 ctoi

      if (ctoi(i)) then
          if ( (i.gt.32 .and. i.lt.63) .or.
     >         (i.gt.95 .and. i.lt.127) ) then
              if (i .eq. Quote) then
                  call tpFm(' Invalid: conflicts with QUOTE')
              else if (i .eq. Bit8) then
                  call tpFm(' Invalid: conflicts with BQUOTE')
              else
                  Repc = i
              endif
          else
              call tpFm('Invalid: value must be 33-62 or 96-126')
          endif
      else
          call tpFm('Usage: SET REPEAT <value (33-62 or 96-126)>')
      endif

      return
      end

      subroutine SetRetry                                ,<890525.1144>
     >Process SET RETRY command
      implicit none

      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      integer*2 i
      logical*2 ctoi,fInit

      if (ctoi(i)) then
          call GetTok(' ')                !Look for (I)nitial
          fInit = cmTk(1:1) .eq. 'I'
          if (i.lt.5 .or. i.gt.30) then
              call tpFm('Invalid: value must be from 5 to 30')
          else
              if ( fInit ) then
                  ImxTry = i
              else
                  maxtry = i
              endif
          endif
      else
          call tpFm('Usage: SET RETRY <number from 5 to 30> [I]')
      endif

      return
      end

      subroutine SetSync                                 ,<890525.1144>
     >Process SET SYNC command
      implicit none

      include kercom.ftni,NOLIST
      integer*2 i
      logical*2 ctoi

      if (ctoi(i)) then
          if (i.lt.1 .or. i.gt.31) then
              call tpFm('Invalid: value must be from 1 to 31')
          else if (i.eq.EOLch .or. i.eq.17) then
              call tpFm('Conflicts with EOL or IBM-PROMPT')
          else
              sync = i
          endif
      else
          call tpFm('Usage: SET SYNC <number from 1 to 31>')
      endif

      return
      end

      subroutine Skip2Bl(ptr)                            ,<890525.1144>
     >Skip to blanks in commands
      implicit none

c     This routine finds the first blank in cmCh past the current
c     PTR position (if any) and returns it in PTR.  If there are no
c     blank characters from PTR to the end of the string, PTR is
c     returned pointing to the end of the string + 1.

      include kercmd.ftni,NOLIST
      integer*2 ptr

      do while (ptr .le. cmLn)            !Stay in the string
          if (cmCh(ptr:ptr) .eq. ' ') then
              return
          else
              ptr = ptr + 1
          endif
      end do

      return
      end

      subroutine SkipBl(ptr)                             ,<890525.1144>
     >Skip blanks in commands
      implicit none

c     This routine finds the first non-blank in cmCh past the current
c     PTR position (if any) and returns it in PTR"  If there are no
c     non-blank characters from PTR to the end of the string, PTR is
c     returned unchanged.

      include kercmd.ftni,NOLIST
      integer*2 i,ptr

      i = ptr
      do while (i .le. cmLn)              !Stay in the string
          if (cmCh(i:i) .ne. ' ') then
              ptr = i
              return
          else
              i = i + 1
          endif
      end do

      return
      end

      subroutine tok_on_true(flag)                       ,<890525.1144>
     >Flag if next token = "ON"
      implicit none

c     This routine sets its parameter "true" if the next command-line
c     token is "ON"; or sets it "false" if that token is "OFF".  If
c     the token is neither of these, subroutine MATCH prints a message,
c     and this routine leaves its parameter alone.

      logical*2   flag
      character*3 on_off(2)
      integer*2   match,i

      data on_off/'OFF','ON'/

      call gettok('?')                    !Locate next token
      i = match(on_off,2)                 !Match it to "ON" or "OFF"
      if (i .eq. 1) then                  !If "OFF" matched...
          flag = .false.                  !...do the "off" thing
      else if (i .eq. 2) then             !If "ON" matched...
          flag = .true.                   !...do the "on" thing
      endif                               !Else do nothing

      return
      end


      subroutine SndFile(*)                              ,<890525.1144>
     >Send file(s)
      implicit none

      include kercmd.ftni,NOLIST          !defines cmTk
      include kercnf.ftni,NOLIST          !defines fRmx
      include kerfil.ftni,NOLIST          !defines mask, first, and fiNm

!     This routine was split into a command-processing section (this one)
!     and a packet-sending section (in the main) for revision 1.99.

      if (.not. fRmx) then                !Are transfers ok?
          call tpFm('You need to SET LINE first')
          return 1
      endif

      call gettok(' ')                    !Get the ind-file or mask
      if (cmTk .eq. ' ') then             !None given?
          call tpFm('Usage: SEND <file-descriptor>')
          return 1
      else
          mask = cmTk
      endif

      call gettok(' ')                    !Look for 2nd file name (initial)
      fiNm = cmTk

      first = .true.
      return

      end

      subroutine RecFile(*)                              ,<890525.1144>
     >Receive file(s)
      implicit none

      include kercmd.ftni,NOLIST          !Defines cmTk
      include kercnf.ftni,NOLIST          !Defines fRmx
      include kerfil.ftni,NOLIST          !Defines mask and first

!     This routine was split into a command-parsing section (this one) and
!     a packet-receiving section (in the 3rd segment) at revision 1.99.

      if (.not. fRmx) then                !OK to transfer files?
          call tpFm('You need to SET LINE first')
          return 1
      endif

      call gettok(' ')                    !Get the optional local name
      first = .true.
      mask = cmTk
      return

      end

      subroutine GetFile(*)                              ,<890525.1144>
     >Receive from a server
      implicit none

      include kercmd.ftni,NOLIST          !Defines cmTk
      include kerfil.ftni,NOLIST          !Defines GetMask, mask, and first

      call gettok(' ')                    !Get the (remote) file name
      if (cmTk .eq. ' ') then             !Was one given?
          call tpFm('Usage: GET <remote-name> [<local-name>]')
          return 1
      else
          GetMask = cmTk                  !Save the mask for the get
      endif

      call gettok(' ')                    !Get optional local file-name
      mask = cmTk
      first = .true.
      return

      end

      subroutine ServerInit(*)                           ,<890525.1144>
     >Start a KERMIT Server
      implicit none

      include kercom.ftni,NOLIST
      include kercnf.ftni,NOLIST          !Defines fRmx

      if (R .ne. L) then                  !If local host...
          call tpFm('Server not available in local-host mode')
          return 1
      else if (.not. fRmx) then
          call tpFm('You are not on a Mux LU')
          return 1
      else
          fServ = .true.
          call tpFm('[KERMIT Server running on an HP-1000 host.')
          call tpFm(' You must escape to your local machine now!]')
      endif
      return

      end

      logical*2 function MustBeLocal()                   ,<890525.1144>
     >Insure local-host mode
      implicit none

      include kercom.ftni,NOLIST

      MustBeLocal = .false.               !Assume we are in remote host
      if (R .eq. L) then                  !Are we remote?
          call tpFm('You need to Set Line to a mux port first!')
      else
          MustBeLocal = .true.
      endif
      return

      end
      program K2MSK(5)                                   ,<890525.1144>
     >KERMIT file-masking
      implicit none

      include kercom.ftni,NOLIST          !To define seg

      seg = 2                             !Keep the segment-loader happy
      call SegRt

      end

      Subroutine NextFile                                ,<890525.1144>
     >Get next file to send
      implicit none

!     The purpose of this routine is to supply an file, opened for reading,
!     to the packet-I/O handler in masked searches.  A simple file-name is
!     handled as if it was a mask, which doesn't bother the file-system at
!     all.  This routine is used only to find files to be sent.

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST

      integer*2 err,dntry(32),j
      integer*2 FmpInitMask,TrimLen,FmpOpen
      logical*2 FmpNextMask
      character*64 name1
      character*5 openopts


      if (first) then                     !Do 1st-entry stuff if needed

          ! On masked searches, 1st entry consists of initializing
          ! the search mask.  Note that, on error, Error will re-
          ! turn to the caller if we are a KERMIT server; otherwise,
          ! execution will continue in the command-processor.
          ! If the initial file-name was given, then we copy it to
          ! Name1 and delay clearing the First flag.

          call FmpEndMask(maCb)           !Be sure old mask is closed
          if (FmpInitMask(maCb,fiEr,mask,CurPath,372) .lt. 0)
     >        call ReportFileError(fiEr,mask)
          if (fiNm .ne. ' ') then         !Was an initial name given?
              name1 = fiNm                !Yes - save it
          else
              first = .false.             !else no initial-name search
          endif

      endif

      ! Normal processing on masked sends involves getting the next
      ! name, as above, but the file-system will tell us if there
      ! is anything else to find.  If an initial file-name was given
      ! we will attempt to match it here.

  10  fMore = FmpNextMask(maCb,fiEr,CurPath,dntry)
      fiNm = ' '
      if (fiEr .lt. 0) then               !On mask error...
          if (fiEr.ne.-208) then          !(except duplicate directory)
              call ReportFileError(fiEr,CurPath)
          else
              if (fMore) goto 10          !Get another name, if possible
              goto 20
          endif
      else
          if (fMore) then
              call FmpMaskName(maCb,fiNm,dntry,CurPath)
          else
              goto 20
          endif
      endif

      if (first) then                     !Doing initial-name search?
          j = TrimLen(name1)              !Use only as much as user gave
          if (name1 .eq. fiNm(:j)) then   !Now check: found it yet?
              first = .false.             !Yes - stop searching
          else
              goto 10                     !not found yet - keep searching
          endif
      endif

!     If we have a file, open it and return the name to the caller

 20   if (fiNm .ne. ' ') then
          if (fBnry) then
              openopts = 'rofx'
          else
              openopts = 'ro'
          endif
          if (FmpOpen(fiCb,fiEr,fiNm,openopts,1) .lt. 0) then
              call ReportFileError(fiEr,fiNm)
              fiNm = ' '
          else
              fiPt = 0                    !Force 1st record to be read
          endif
      endif

      return                              !Return to main

      end
      program K3XFR(5)                                   ,<890525.1144>
     >KERMIT file-transfer
      implicit none

      include kercom.ftni,NOLIST          !To define seg

      seg = 3
      call SegRt

      end
      subroutine bye                                     ,<890525.1144>
     >BYE command processor
      implicit none

      include kercom.ftni,NOLIST
      integer retry,err,num,len
      logical*2 fRtryi
      character*1 ptype,RecPack

c     This routine sends a generic-logout packet to a server running on
c     another system.  On success, we terminate gracefully.

      pdata = 'L'                         !Set data to L(ogout)
      retry = 0                           !Reset retry counter

 10   if ( fRtryi(retry) ) then           !Exceeded retry limit?
          call tpFm('Unable to send LOGOUT')
          return                          !Go back to command processor
      endif

      call SndPack('G',seq,1)             !Send the logout packet
      ptype = RecPack(len,num)            !Get the response

      if (ptype .eq. 'T') then            !time-out?
          call tpFm('<timed out>')
          goto 10

      else if (ptype .eq. 'N') then       !NAK?
          if (mod(seq+1,64) .ne. num) goto 10
          ptype = 'Y'
          num = num - 1
      endif

      if (ptype .eq. 'Y') then            !ACK?
          if (seq .ne. num) goto 10
          call quit                       !Shut ourselves down
          Stop
      else if (ptype .eq. 'X') then       !Checksum error?
          call tpFm('Checksum error; retrying')
      else if (ptype .eq. 'E') then       !Error packet?
          call tpCh('Received error packet: -',RecPkt(5:len+4),0)
          return
      else
          call tpCh('Unknown packet type: -',ptype,1)
      endif
      goto 10

      end

      subroutine finish                                  ,<890525.1144>
     >FINISH command processor
      implicit none

      include kercom.ftni,NOLIST
      integer*2 retry,err,len,num
      logical*2 fRtryi
      character*1 ptype,RecPack

      pdata = 'F'                         !Set data to F(inish)
      retry = 0

 10   if ( fRtryi(retry) ) then
          call tpFm('Unable to FINISH')
          return
      endif

      call SndPack('G',seq,1)             !Send the finish packet
      ptype = RecPack(len,num)

      if (ptype .eq. 'T') then            !time-out?
          call tpFm('<timed out>')
          goto 10

      else if (ptype .eq. 'N') then       !NAK?
          if (mod(seq+1,64) .ne. num) goto 10
          ptype = 'Y'
          num = num - 1
      endif

      if (ptype .eq. 'Y') then            !ACK?
          if (num .ne. seq) goto 10
          return
      else if (ptype .eq. 'X') then       !Checksum error?
          call tpFm('Checksum error - retrying')
      else if (ptype .eq. 'E') then       !Error packet?
          call tpFm('Received error packet:')
          call tpFm(RecPkt(5:len+4))
          return
      else
          call tpCh('Unknown packet type: -',ptype,1)
      endif

      goto 10

      end

      subroutine Logoff3                                 ,<890525.1144>
     >(LogOff caller)
      implicit none

      call LogOff                         !We never return...
      call exec(6)                        !(just in case)

      end

      logical*2 function receive(istate)                 ,<890525.1144>
     >Receive-state switch
      implicit none

c     This routine performs state switching for file-receive operations.
c     If file-recepetion is successful, receive returns .true.

      include kercom.ftni,NOLIST
      include kerdbg.ftni,NOLIST
      include kersta.ftni,NOLIST
      character*(*) istate
      integer*2 retry
      character*1 rdata,rinit,rfile
      character*3 c_r

      state = istate                      !Show receiving state
      call startstats                     !restart statistics logging
      retry = 0
      c_r = char(13) // ' _'
      receive = .false.

 10   call kdebug(states,'RxState: ',state)
      if (retry .ne. 0) rtry = rtry + 1
      if (R .ne. L) then
          call tpI2(c_r,rpak,6)
          call tpI2('/_',rtry,-3)
          call tpFm(' _-')
      endif

      if (state .eq. 'D') then            !read a DATA packet
          state = rdata(retry)
      else if (state .eq. 'R') then       !read a SINIT packet
          state = rinit(retry)
      else if (state .eq. 'F') then       !read a file header
          state = rfile(retry)
      else if (state .eq. 'C') then       !file transfer complete?
          call endstats                   !turn off statistics logging
          sCheck = 1                      !Revert to type-1 checksums
          receive = .true.
          return
      else if (state .eq. 'E') then       !We received an error packet
          call endstats
          call fClose
          if (.not. fServ) call tpFm(ErrMsg)
          return
      else if (state .eq. '!') then       !we got an error
          call endstats
          call fClose
          call SndErr
          return
      else                                !Unknown receive state
          call endstats
          call fClose
          ErrMsg = 'Receive-state error; state = ' // state
          call kdebug(states,ErrMsg,' ')
          if (R .ne. L) then
              call tpFm(ErrMsg)
          endif
          call SndErr
          return
      endif

      goto 10

      end

      character*1 function rinit(retry)                  ,<890525.1144>
     >Receive initial packet
      implicit none

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST          !To define fBnry
      integer*2 retry,len,num,svCheck
      logical*2 fRtryi
      character*1 ptype,recpack

      rinit = state                       !Assume no state change

      if ( fRtryi(retry) ) then
          rinit = '!'                     !exceeded max. # of re-try
          return                          !give up
      endif

      ptype = recpack(len,num)            !read a packet
      if (ptype .eq. 'S') then            !we got a SINIT packet
          call RecPar(len)                !store partner's params
          if (fBnry .and. Parity.ne.3 .and. .not.fBit8) then
              ErrMsg = 'Can''t receive binary file (parity problem)'
              call SndErr
              fBnry = .false.
              rinit = 'E'
              return
          endif
          call SndPar('Y',num)            !Send my parameters now
          sCheck = newChk                 !OK to change check type now
          seq = mod(num+1,64)             !Set new sequence number
          retry = 0                       !Clear the retry counter
          rinit = 'F'                     !New state = File header
      else if (ptype .eq. 'X') then       !we got a checksum error
          call SndPack('N',num,0)         !NAK the packet
      else if (ptype .eq. 'T') then       !Timed out?
          call SndPack('N',seq,0)         !just nak it
      else if (ptype .eq. 'E') then       !Error packet?
          ErrMsg = 'Sender error: ' // RecPkt(5:len+4)
          rinit = 'E'
      else
          ErrMsg = 'Unknown packet type: ' // ptype
          rinit = '!'                     !Unexpected packet, so give up
      endif

      return
      end

      character*1 function rfile(retry)                  ,<890525.1144>
     >Read file-header packet
      implicit none

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST
      integer*2 retry,num,len,FmpOpen,TrimLen,err,typ
      logical*2 fRetry
      character*1 recpack,ptype
      character*5 openopts

      if ( fRetry(retry) ) then
          rfile = '!'
          return
      endif

      rfile = state
      ptype = RecPack(len,num)            !Read a packet
      if (ptype .eq. 'F') then            !we got a file-header
          if (num .ne. seq) then          !If the sequence# is bad...
              ErrMsg = 'Bad sequence number'
              rfile = '!'                 !...abort
              return
          endif
          pdata = RecPkt(5:len+4)         !copy off the file-name info...
          call legalize(typ)              !...validate & move it to fiNm
          openopts = 'wc'                 !min open options: write & create
          if (.not. fWarn) then           !If files can be overlayed...
              call chApp(openopts,'o')    !allow (O)ld files
          endif
          if (fBnry) then                 !If in binary mode...
              call chApp(openopts,'f')    !...(F)orce to type 1
              if (typ .ne. 6) then        !if not an rp-able program...
                  call chApp(openopts,'x')!...allow e(X)tent access
              endif
          endif
          if (FmpOpen(fiCb,err,fiNm,openopts,1) .lt. 0) then
              Call ReportFileError(err,fiNm)
          else
              fiCh = ' '                  !Clear the record buffer
              fiPt = 0                    !Set record pointer
              call SndPack('Y',num,0)
              seq = mod(seq+1,64)
              rfile = 'D'                 !Switch to data state
              if (R.ne.L) then            !Display the file name locally
                  call tpCh('Receiving -',fiNm,TrimLen(fiNm))
              endif
              retry = 0
          endif

      else if (ptype .eq. 'S') then       !Old send-init packet?
          if (mod(num+1,64) .eq. seq) then
              call SndPar('Y',num)        !Yes - send my parameters
              retry = 0
          else
              ErrMsg = 'Bad sequence# on old SINIT'
              rfile = '!'
          endif

      else if (ptype .eq. 'Z') then       !Old EOF packet?
          if (mod(num+1,64) .eq. seq) then
              call SndPack('Y',num,0)     !Yes - just ack it
              retry = 0
          else
              ErrMsg = 'Bad sequence# on old EOF'
              rfile = '!'
          endif

      else if (ptype .eq. 'B') then       !Break packet?
          if (num .ne. seq) then
              ErrMsg = 'Bad sequence# on BREAK'
              rfile = '!'
          else
              call SndPack('Y',num,0)
              rfile = 'C'                 !Change state to Complete
              retry = 0
          endif

      else if (ptype .eq. 'X') then       !Checksum error?
          call SndPack('N',num,0)

      else if (ptype .eq. 'T') then       !Time-out?
          call SndPack('N',seq,0)         !just NAK it

      else if (ptype .eq. 'E') then       !Error packet?
          ErrMsg = 'Sender error: ' // RecPkt(5:len+4)
          rfile = 'E'

      else                                !Invalid packet type
          ErrMsg = 'Unknown packet type: ' // ptype
          rfile = '!'
      endif

      return
      end

      subroutine chApp(dest,newstuff)                    ,<890525.1144>
     >Append to string
      implicit none

      character*(*) dest,newstuff
      integer*2 TrimLen,i

      i = TrimLen(dest) + 1           !Find 1st available character
      if (i .le. Len(dest)) dest(i:) = newstuff

      return
      end

      character*1 function rdata(retry)                  ,<890525.1144>
     >Receive data packet
      implicit none

      include kercom.ftni,NOLIST
      integer*2 retry,num,len
      logical*2 fRetry
      character*1 ptype,recpack

      rdata = state                       !Assume no change in state
      if ( fRetry(retry) ) then
          rdata = '!'
          return
      endif

      ptype = recpack(len,num)            !read a packet

      if (ptype .eq. 'D') then            !we got the data packet
          if (num .ne. seq) then          !Sequence error?
              if (mod(num+1,64).eq.seq) then   !Was prev packet re-sent?
                  call SndPack('Y',num,0)      !Yes - just ack it
                  retry = 0
              else
                  ErrMsg = 'Bad Sequence#'
                  rdata = '!'
              endif
          else
              call BufEmp(len)            !Sequence # ok - copy to disc
              call SndPack('Y',num,0)     !Ack the packet
              seq = mod(num+1,64)         !Bump the sequence number
              retry = 0                   !Show no more retries
          endif

      else if (ptype .eq. 'F') then       !Old filename packet?
          if (mod(num+1,64).eq.seq) then  !Yes - sequence# ok?
              call SndPack('Y',num,0)     !Yes - ack it
              retry = 0                   !Show no retries
          else
              ErrMsg = 'Bad Sequence#'
              rdata = '!'
          endif

      else if (ptype .eq. 'Z') then       !EOF packet?
          if (num .ne. seq) then          !Yes - sequence# ok?
              rdata = '!'                 !No - abort the transfer
          else
              call SndPack('Y',num,0)     !Yes - ACK it
              call dputc(-2)              !Post poss pending buffer to file
              rdata = 'F'                 !Look for another file-header
              seq = mod(num+1,64)         !Set next sequence number
              retry = 0
          endif
          call fClose

      else if (ptype .eq. 'X') then       !Checksum error?
          call SndPack('N',num,0)         !NAK the packet

      else if (ptype .eq. 'T') then       !time-out?
          call SndPack('N',seq,0)

      else if (ptype .eq. 'E') then       !Error packet?
          ErrMsg = 'Sender error: ' // RecPkt(5:len+4)
          rdata = 'E'

      else                                !Unknown packet type?
          ErrMsg = 'Unknown packet type: ' // ptype
          rdata = '!'                     !Abort the transfer
      endif

      return
      end

      subroutine legalize(typ)                           ,<890525.1144>
     >Insure valid file names
      implicit none

c     This routine is called for any received file to insure that its name
c     is valid in this system.  Name validity has two main components:
c         * No illegal characters
c         * Correct specification of directory path
c     Once validity is insured, this routine copies that name to fiNm, the
c     global used for files' names in KERMIT-RTE.
c
c     The first issue is addressed by editing the file name so that any
c     occurrences of "+", "-", ",", or "@" are changed to an underscore.
c     If the first character is numeric, it also is replaced by an under-
c     score, as are any embedded blanks in the name.  RTE system can only
c     use a period to separate file-names from the type-extension, if the
c     other system uses something else, this system won't understand but
c     won't change it unless it violates one of the rules above.  "/" and
c     ":" are used in different contexts to describe directory paths in
c     this system; if they appear in the name sent from the other system,
c     they and their associated information will be removed!
c
c     This routine causes the file to be put into the current working-
c     directory, or into the directory given by the first parameter of
c     a RECEIVE command or the second parameter of the GET command.  If
c     there is no active working-directory and no directory was given
c     by the RECEIVE or GET command, the file will be put in FMGR-space,
c     and the file-name will be truncated to the left-most 6 characters.
c
c     NOTE: if a full file name is given in GET or RECEIVE, that name is
c     used for the first file received only; any other files received in
c     the same stream can be renamed in all parts BUT the file name.

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST
      integer*2   ij,sc,typ,rl,i,TrimLen
      character   name*16,typx*4,rtpx*4,ds*40,junk*1

      if (first) then                     !First time after GET or RECEIVE?
          ds = ' '                        !Clear the DS-information string
          rtpx = ' '                      !...and the (mask) type-extendion
          first = .false.                 !Don't do this again
          if (mask .ne. ' ') then         !If a name was given...
              fiNm = mask                 !Is it a name and/or a mask?
              call FmpParsePath(fiNm,mask,name,rtpx,junk,sc,typ,fiSz,
     >                          rl,ds)    !NOTE: qualifier is illegal here
                                          !      but DS-stuff is not!
              call checkname(rtpx)        !Validate the type-extension
              if (name .ne. ' ') then          !If anything is left...
                  if (rtpx .ne. ' ') then      !do we also have type-ext?
                      i = TrimLen(name)
                      pdata = name(:i) // '.' // rtpx
                  else
                      pdata = name
                  endif
              endif
          endif
          if (typ .lt. 1) typ = 4         !Default to var-length/editable
          if (fiSz.lt. 1) fiSz = 24       !...and 24 blocks
          if (rl .lt. 0) rl = 0
      endif

c     Directory-, qualifier-, or DS-info will never be sent from another
c     KERMIT, but I parse for them in the following call (the "JUNK" in
c     3 places) so that I won't be fooled by something that looks like
c     that kind of stuff.  Further, the security-code, file-type, -size,
c     and -record-length fields are also dummies ("IJ" in 4 places).

      call FmpParsePath(pdata,junk,name,typx,junk,ij,ij,ij,ij,junk)

      call CheckName(name)                !Replace illegals in the name
      if (rtpx .ne. ' ') then             !Replace type-extension?
          typx = rtpx                     !Yes - do it
      else
          call CheckName(typx)            !Replace illegals in type-extension
      endif

c     Now reconstruct the name.  If anything beyond a file-name was given in
c     a GET or RECEIVE command, it was parsed above; it will now be used
c     here to build a full file-name.

      call FmpBuildPath(fiNm,mask,name,typx,' ',sc,typ,fiSz,rl,ds)

      return
      end

      subroutine CheckName(name)                         ,<890525.1144>
     >Make file-name info legal
      implicit none

      character*(*) name
      integer*2     i,TrimLen
      character*1   b

c     This routine checks file-name and -extensions to insure that all
c     occurrences of '+', '-', ',', '@', leading numeric characters, and
c     embedded blanks or control-characters are replaced by '!'.

      do i = 1,TrimLen(name)              !Scan the file name
          b = name(i:i)                   !Extract a character
          if (i .eq. 1) then              !Check for numeric 1st character
              if (b.ge.'0' .and. b.le.'9') then
                  b = '!'
              endif
          else if (b .eq. '+') then
              b = '!'
          else if (b .eq. '-') then
              b = '!'
          else if (b .eq. '@') then
              b = '!'
          else if (b .eq. ',') then
              b = '!'
          else if (b .le. ' ') then
              b = '!'
          endif
          name(i:i) = b                   !Replace (possibly) changed byte
      end do

      return
      end

      character*1 function sinit(retry)                  ,<890525.1144>
     >Send initial packet
      implicit none

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST
      integer*2 retry,num,len,FmpOpen,err
      logical*2 fRtryi
      character*1 ptype,RecPack
      character*4 openopts

      if ( fRtryi(retry) ) then           !Retry limit exceeded?
          sinit = '!'                     !Yes - abort the send
          call SendAbort                  !Close all associated files
          return
      endif

      sCheck = 1                          !SINIT always uses 1-byte checks
      call SndPar('S',seq)                !Send my parameters
      ptype = RecPack(len,num)            !Get the response
      sinit = state                       !Assume no change in state

      if (ptype .eq. 'N') then            !NAK?
          return                          !Yes - try again
      else if (ptype .eq. 'T') then       !Time-out?
          return                          !try again

      else if (ptype .eq. 'E') then       !Error packet?
          ErrMsg = 'Receiver error: ' // RecPkt(5:len+4)
          sinit = 'E'
          call SendAbort
          return

      else if (ptype .eq. 'Y') then       !ACK?
          if (seq .ne. num) then          !Yes - for this packet?
              return                      !No - try again
          endif
          call RecPar(len)                !Get partner's parameters
          sCheck = NewChk                 !Ok to do new checksum type now
          if (fBnry .and. Parity.ne.3 .and. .not.fBit8) then
              ErrMsg = 'Can''t send binary file (parity problem)'
              fBnry = .false.
              sinit = 'E'
              call SendAbort
              return
          endif
          retry = 0                       !Clear the retry counter
          seq = mod(seq+1,64)             !Get next sequence number
          if (fBnry) then
              openopts = 'rofx'
          else
              openopts = 'ro'
          endif
          if (FmpOpen(fiCb,err,fiNm,openopts,1).lt.1) then
              call ReportFileError(err,fiNm)
          else
              fiPt = 0                    !Force a record to be read
              sinit = 'F'                 !Go to File-name state
          endif

      else if (ptype .ne. 'X') then       !Any response except checksum err?
          ErrMsg = 'Unknown packet type: ' // ptype
          sinit = '!'                     !Yes - abort the send
          call SendAbort
      endif

      return
      end

      character*1 function sfile(retry)                  ,<890525.1144>
     >Send file-name packet
      implicit none

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST
      integer*2 retry,len,num,TrimLen,j
      logical*2 fRetry
      character*1 ptype,RecPack
      character name*16,typex*4,cj*1

      if ( fRetry(retry) ) then           !Exceeded retry limit?
          sfile = '!'                     !Yes - abort the transfer
          call SendAbort                  !Close all files
          return
      endif

c     Get the "normal form" of the file-name.  The "J" and "CJ" variables
c     are "junk" (unused fields) from the parse.

      call FmpParsePath(fiNm,cj,name,typex,cj,j,j,j,j,cj)
      j = TrimLen(name)
      if (typex .ne. ' ') then            !Was a type-extension given?
          pdata = name(:j) // '.' // typex
      else
          pdata = name
      endif
      call SndPack('F',seq,TrimLen(pdata))  !Send the file name
      ptype = RecPack(len,num)            !Get the response
      sfile = state                       !Assume no change in state

      if (ptype .eq. 'T') then            !Time-out?
          return                          !just retry

      else if (ptype .eq. 'E') then       !Error packet?
          ErrMsg = 'Receiver error: ' // RecPkt(5:len+4)
          sfile = 'E'
          call SendAbort
          return

      else if (ptype .eq. 'N') then       !NAK or time-out?
          if (mod(seq+1,64) .ne. num) then
              return
          else
              ptype = 'Y'
              num = num - 1
          endif
      endif

      if (ptype .eq. 'Y') then            !ACK?
          if (seq .ne. num) then
              return
          endif
          retry = 0
          seq = mod(seq+1,64)             !Get next sequence number
          sfile = 'D'                     !Go to the data state
          if (R.ne.L) then                !Display the file name locally
              call tpCh('Sending -',fiNm,TrimLen(fiNm))
          endif
          call buffill                    !Get first data packet's worth

      else if (ptype .ne. 'X') then       !Anything else but checksum err...
          ErrMsg = 'Unknown packet type: ' // ptype
          sfile = '!'                     !...makes us abort the send
          call SendAbort
      endif

      return
      end

      character*1 function sdata(retry)                  ,<890525.1144>
     >Send file-data packets
      implicit none

      include kercom.ftni,NOLIST
      integer*2 retry,len,num,buffill
      logical*2 fRetry
      character*1 ptype,RecPack

      if ( fRetry(retry) ) then           !Exceeded retry limit?
          sdata = '!'                     !Yes - give up
          call SendAbort
          return
      endif

      sdata = state                       !Assume no change in state
      call SndPack('D',seq,slen)          !Send the data packet

      ptype = RecPack(len,num)            !Get the reply

      if (ptype .eq. 'T') then            !Time-out?
          return                          !Just retry

      else if (ptype .eq. 'E') then       !Error packet?
          ErrMsg = 'Receiver error: ' // RecPkt(5:len+4)
          sdata = 'E'
          call SendAbort
          return

      else if (ptype .eq. 'N') then       !Got a NAK?
          if (mod(seq+1,64) .eq. num) then
              return
          else
              ptype = 'Y'                 !A NAK on the 'next' packet is
              num = num - 1               !...an ACK on this one
          endif
      endif

      if (ptype .eq. 'Y') then            !Got an ACK?
          if (seq .ne. num) return
          retry = 0
          seq = mod(seq+1,64)
          if (buffill() .lt. 1) then      !Did we get EOF?
              sdata = 'Z'                 !Yes - change state
          endif

      else if (ptype .ne. 'X') then       !Something besides checksum?
          ErrMsg = 'Unknown packet type: ' // ptype
          sdata = '!'                     !Abort the transfer
          call SendAbort
      endif

      return
      end

      character*1 function sbreak(retry)                 ,<890525.1144>
     >Send EOT packet
      implicit none

      include kercom.ftni,NOLIST
      integer*2 retry,len,num
      logical*2 fRetry
      character*1 ptype,RecPack

      if ( fRetry(retry) ) then           !Did we exceed the retry limit
          sbreak = '!'                    !Yes - abort the transfer
          call SendAbort
          return
      endif

      sbreak = state                      !Assume no state change
      call SndPack('B',seq,0)
      ptype = RecPack(len,num)

      if (ptype .eq. 'T') then            !timed out?
          return                          !just retry

      else if (ptype .eq. 'E') then       !Error packet?
          ErrMsg = 'Receiver error: ' // RecPkt(5:len+4)
          sbreak = 'E'
          call SendAbort
          return

      else if (ptype .eq. 'N') then       !Were we NAKed?
          if (mod(seq+1,64).ne.num) then  !Yes - is it an old NAK?
              return                      !No - do another break
          else
              ptype = 'Y'
              num = num - 1
          endif
      endif

      if (ptype .eq. 'Y') then            !Were we ACKed?
          if (num .ne. seq) then          !Yes - in sequence?
              return                      !No - do the break again
          endif
          retry = 0
          seq = mod(seq+1,64)
          sbreak = 'C'                    !Change to Complete status

      else if (ptype .ne. 'X') then       !Anything else but checksum?
          ErrMsg = 'Unknown packet type: ' // ptype
          sbreak = '!'                    !Yes - abort the send
          call SendAbort
      endif

      return
      end

      integer*2 function buffill()                       ,<890525.1144>
     >Fill transmit buffer
      implicit none

c     This routine copies data from the sending disc file to the data
c     portion of the transmit packet.  It is responsible for assuring
c     that control, 8th-bit, and repeat-count prefixing sequences are
c     not broken across a packet boundary.

      include kercom.ftni,NOLIST
      integer*2 i,j,b,dgetc,ctl,psave,DataMax,TrimLen,xbufL
      character*20 xBuf                   !"excess" buffer
      data xBuf /' '/                     !(SegLd always clears this)

      p = 1                               !Reset packet byte pointer
      DataMax = sPkSiz - (sCheck+1)       !(This is last available byte + 1)
      if (xBuf .ne. ' ') then             !Anything in the overflow buffer?
          pData = xBuf                    !Yes - put it in front of packet
          p = xBufL + 1                   !...and reset pointer to end of it
          xBuf = ' '                      !(show overflow buffer is clear)
      endif
      do while (dgetc(b) .ge. 0)          !Read from disc 'til EOF

          psave = p                       !In case of buffer overflow
          if (fRepc) then                 !Can we do repeat-counts?
              i = 1                       !Yes - find non-match/too many
              do while (dgetc(j).eq.b .and. i.lt.94)
                  i = i + 1               !Max repeat-count is 94
              end do
              call dPutBack(j)            !Put back the non-match
              if (i .lt. 4) then          !Below the repeat threshold?
                  do while (i .gt. 1)     !Yes - put 'em all back
                      call dPutBack(b)
                      i = i - 1
                  end do
              else
                  call pPutc(sRepc)       !Yes - plug in the prefix
                  call pPutc(i + 32)      !Make the count printable
              endif
          endif

          if (fBit8 .and. b.gt.127) then  !Do 8th-bit prefixing?
              call pPutc(sBit8)           !Yes - output the prefix
              b = iand(b,127)             !...then clear 8th bit
          endif

          if (b.lt.32 .or. b.eq.127 .or. b.eq.sQUOTE .or.
     >                      (b.eq.sBit8 .and. fBit8) .or.
     >                      (b.eq.sRepc .and. fRepc)      ) then
              call pPutc(sQUOTE)          !We need to quote a character
              if (b.lt.32 .or. b.eq.127) b = ctl(b)
          endif
          call pPutc(b)

          if (p .eq. DataMax) then        !Packet exactly filled?
              goto 10
          elseif (p .gt. DataMax) then    !Packet too full?
              xBuf = pData(psave:p)       !Save part that doesn't fit
              xbufL = p - psave           !Save length of the overflow
              p = psave                   !Back up to last char that fits
              goto 10                     !Done with this packet
          endif
      end do

c     Falling thru to here means we hit EOF in the disc file, or the packet
c     is full.  If at EOF and this routine is called again, it will return
c     zero, and SDATA will know to go to EOF state.

 10   slen = p - 1
      buffill = slen

      return
      end

      integer*2 function dGetc(b)                        ,<890525.1144>
     >Get a disc-file byte
      implicit none

c     The RTE file-system doesn't readily accept the notion that a file
c     could be a "stream" of bytes.  This subroutine fills that gap by
c     doing record unpacking and a limited "push-back" facility.

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST
      include kerdbg.ftni,NOLIST

      integer*2 dPutBack,b,pbbyt
      logical*2 EORpend
      integer*2 pbpt,err,fiBf(128)
      integer*2 FmpRead
      character pbbf*20                   !Push-back buffer
      equivalence (fiCh,fiBf)
      data pbpt /0/                       !if > 0, is a push-back pointer
      data EORpend /.false./              !EOR sequence is not pending

      if (pbpt .gt. 0) then               !Was a byte pushed back?
          b = ichar(pbbf(pbpt:pbpt))      !Yes - get it
          pbpt = pbpt - 1                 !Back up the push-back pointer
          goto 20
      endif

      if (EORpend) then                   !Doing 2nd byte of EOR sequence?
          EORpend = .false.               !Not any more
          b = 10                          !Return the LF character
          goto 20
      endif

 10   if (fiPt .lt. 1) then               !Need to read a record?
          fiLn = FmpRead(fiCb,err,fiBf,MAXREC)   !Yes - do it
          if (err .lt. 0) then                   !File-read error?
              if (fBnry .and. err.eq.-12) then   !EOF during binary mode?
                  fiLn = -1                      !Yes - show EOF
              else
                  call ReportFileError(err,fiNm) !Else report other errors
              endif
          endif
          fiPt = 1                               !Point to 1st byte
      endif

      if (fiLn .lt. 0) then               !EOF? (always returns -1)
          b = -1                          !NOTE: EOF can't be pushed back!
          goto 20
      endif

      if (fiPt .gt. fiLn) then            !EOR?
          fiPt = 0                        !Yes - Arrange to get next record
          if (fBnry) goto 10              !Don't map EOR to CRLF if binary
          b = 13                          !Else flag with a CR
          EORpend = .true.                !Be sure to do 2nd byte of EOR
      else
          b = ichar( fiCh(fiPt:fiPt) )    !Get the current byte
          fiPt = fiPt + 1                 !Point to next byte
      endif

 20   dGetc = b                           !Return byte as function value
      return

      entry dPutBack(pbbyt)

      if (pbpt .ge. 20) then              !Too many pushed back?
          ErrMsg = 'Too many bytes pushed back!'
          call kDebug(all,ErrMsg,' ')
          call SndErr
          call quit
      else if (pbbyt .ge. 0) then         !(Don't push EOF back!)
          pbpt = pbpt + 1                 !Bump the pointer
          pbbf(pbpt:pbpt) = char(pbbyt)   !"push back" the byte
      endif

      return
      end

      subroutine BufEmp(len)                             ,<890525.1144>
     >Empty receive-buffer
      implicit none

c     This routine writes the packet buffer contents to the receiving
c     disc file.  Note that the "LEN" parameter is actually a pointer
c     to the last data-byte in the packet (type-2/-3 checksums???)

      include kercom.ftni,NOLIST

      integer*2 ctl,i,len,b
      logical*2 f8Set
      integer*2 rep,j

      i = 5                               !1st data byte is packet byte #5
      do while (i .le. len+4)             !put (len) bytes in disc file
          b = ichar(R1cPkt(i))            !Get next packet byte

          if (fRepc .and. b.eq.Repc) then !Is this my repeat-count char?
              i = i + 1                   !Yes - bump to the count itself
              rep = ichar(R1cPkt(i))-32   !Get the count
              i = i + 1                   !position to next byte
              b = ichar(R1cPkt(i))        !Get character to repeat
          else
              rep = 1                     !Default repeat-count to 1
          endif

          if (fBit8 .and. b.eq.Bit8) then !Do 8th-bit prefixing?
              f8Set = .true.              !Yes - set the bit-8 flag
              i = i + 1                   !...and bump the byte pointer
              b = ichar(R1cPkt(i))
          else
              f8Set = .false.
          endif

          if (b .eq. Quote) then          !If this is my quote character
              i = i + 1                   !...bump the byte pointer
              b = ichar(R1cPkt(i))        !...and get the next byte
              if (b.ge.63 .and. b.le.95) then  !if in range...
                  b = ctl(b)              !...de-controllify it (else it is
              endif                       !sent literally after a quote)
          endif

          if (f8Set) b = ior(b,200b)      !Turn on 8th bit as needed

          do j = 1,rep                    !Repeat-count processing
              call dPutc(b)               !Put the byte in the file
          end do
          i = i + 1
      end do
      return
      end

      subroutine dPutc(b)                                ,<890525.1144>
     >Write byte in file-buffer
      implicit none

      include kerfil.ftni,NOLIST

      integer*2 b,err,fiBf(129)
      logical*2 CRpend                    !True if CR is pending
      logical*2 fEmpty                    !True if file-buffer is empty
      equivalence (fiCh,fiBf)
      data CRpend /.false./

c     This routine is called with a single INTEGER parameter (b) being the
c     ichar() of the byte to store into the record, except:
c         b = -2: post the current (non-empty) record
c         b = -1: post the current record, empty or not
c     If b is any other negative number, it is not written to the file.

      if (b.eq.-2 .and. fEmpty) return    !This was an un-needed post call
      fEmpty = .false.

      if (fBnry) goto 10                  !Don't map CRLF to EOR if binary

      if (CRpend) then                    !Is a CR pending?
          CRpend = .false.                !Yes - not after this stuff
          if (b.eq.10 .or. b.lt.0) then   !Is this the logical EOR?
              b = -1                      !Yes - flag it
          else
              fiPt = fiPt + 1             !Not EOR, so store the CR
              fiCh(fiPt:fiPt) = char(13)  !...into the file
          endif
      endif

      if (b .eq. 13) then                 !Is this a CR?
          CRpend = .true.                 !Yes - flag it for next call
          return                          !Don't write it to the file (yet)
      endif

!     Do end-of-record (EOR) processing if requested (b=-1) or if the
!     record-buffer gets "full".

 10   if (fiPt.ge.MAXREC .or.  b.lt.0) then
          call FmpWrite(fiCb,err,fiBf,fiPt)
          if (err .lt. 0) then
              call ReportFileError(err,fiNm)
          endif
          fiCh = ' '                      !Clear the record buffer
          fiPt = 0                        !Reset char pointer
          fEmpty = .true.                 !"buffer is empty"
      endif

      if (b .ge. 0) then                  !Add this byte to the record?
          fiPt = fiPt + 1                 !Yes - bump the pointer
          fiCh(fiPt:fiPt) = char(b)       !...and add the byte
      endif

      return
      end

      logical*2 function fRetry(try)                     ,<890525.1144>
     >OK to retry?
      implicit none

      include kercom.ftni,NOLIST
      integer*2 try,tmax
      logical*2 IfBrk,fInit,tf
      logical*2 fRtryI                    !Alternate entry for initial retry

      tmax = MaxTry                       !Set for "normal" retry-limit
      fInit = .false.                     !Not doing initial retry limiting
      goto 10

      entry fRtryi(try)
      tmax = ImxTry                       !Set for initial retry limit
      fInit = .true.                      !Doing initial retry-limiting

 10   tf = .true.                         !Intialize to 'not ok to retry'
      if (try .gt. tMax) then
          ErrMsg = 'Retry limit exceeded'
          if (R .ne. L) call tpFm(ErrMsg)
      else
          try = try + 1
          tf = .false.
      endif

      If (IfBrk()) then                   !Operator break?
          tf = .true.
          ErrMsg = 'Operator break'
          if (R .ne. L) call tpFm(ErrMsg)
      endif

      if ( fInit ) then                   !Doing Initial or normal?
          fRtryi = tf
      else
          fRetry = tf
      endif

      return
      end

      character*1 function RecPack(len,num)              ,<890525.1144>
     >Read a packet
      implicit none

      include kercom.ftni,NOLIST
      include kerdbg.ftni,NOLIST
      include kersta.ftni,NOLIST

      integer*2 len,num
      integer*2 unchar,getpak
      integer*2 RecBuf,i,b,ck,type,numw1(3),numw2(3),check1
      character num1*2,num2*2,work*10,rpinfo*256
      equivalence (RecBuf,RecPkt),(num1,numw1(3)),(num2,numw2(3))

c     By definition, anything I read in will terminate with EOLch (a
c     carriage-return), so all I need to do is left-justify the SYNC
c     portion in the packet-buffer.  Packet input is always from the
c     REMOTE lu.  The rest of the routine "parses" the packet into
c     fields by setting appropriate variables.
c     RECPACK returns the packet-type as its value, or a 'bad-packet'
c     indicator if the checksum is bad.  The data length is returned
c     in LEN, and the sequence number is returned in NUM.

c     NOTE: it is assumed that type-ahead has been enabled prior to
c           calling this routine.  RTE's internal I/O processing
c           makes "true" full-duplex impossible (see the code in
c           CONNECT for proof of this); type-ahead on the mux card
c           at least allows us to capture data sent to us before we
c           are actually ready to receive it.  (While testing KERMIT
c           with two computers of different execution speed, data
c           losses DID occur because of the time needed to do stuff
c           between the sending of a packet and receipt of the ACK
c           or NAK.)

 5    i = getpak()                        !Do system-dependent packet-read

      if ( btest(i,rtoBit) ) then         !Did we time-out?
          recpack = 'T'                   !Give'em a time-out
          return
      endif
      if (rlen .lt. 1) goto 5             !Must have been just a <CR>
      rbytes = rbytes + rlen              !Count bytes
      rovrhd = rovrhd + rlen              !all are overhead for now
      RecPkt(rlen+1:) = ' '               !Clear unused part of packet
      call IBMrd                          !look for IBM-PROMPT as needed
      call kdebug(packets,'RecPack: ',RecPkt(:rlen))
      rpak = rpak + 1                     !Count a received packet
      p = index(RecPkt,char(Sync))        !Find the sync character
      if (p .lt. 1) goto 5                !No sync mark; retry read

 10   if (p .lt. 1) then                  !No sync found?
          RecPack = 'T'                   !Act as if it timed out
          return
      endif
      if (p .gt. 1) then                  !Left-justify the sync byte
          rpinfo = RecPkt(p:)             !(Ftn7x can't assign substring to
          RecPkt = rpinfo                 !  a variable of the same name)
          rlen = rlen - (p - 1)           !Adjust the packet-length
          p = 1                           !Reset the pointer to the mark
      endif
      len  = -1                           !Clear the field variables to
      num  = -1                           !  allow each field to be picked
      type = -1                           !  off in the correct order
      i = 0                               !Clear the data-byte counter

      do while (p .le. rlen)              !Scan the packet
          p = p + 1                       !Go to next byte
          b = ichar(R1cPkt(p))            !...and get it

          if (b .eq. Sync) then           !Re-sync?
              goto 10

          else if (len .lt. 0) then       !Do data-length field
              len = unchar(b)-2-sCheck    !...set data length

          else if (num .lt. 0) then       !Do sequence-number field
              num = unchar(b)

          else if (type .lt. 0) then      !Do packet-type field
              type = b

          else if (i .lt. len) then       !Do packet-data field (if any)
              i = i + 1                   !Count a data byte

          else                            !Do checksum field
              ck = check1(R1cPkt,p)       !Compute the checksum
              b = unchar(b)
              if (ck .ne. b) then         !bad checksum?
                  recpack = 'X'           !...report it to sender
                  call cnumd(ck,numw1)    !computed cksm --> ASCII
                  call cnumd(b,numw2)     !actual cksm --> ASCII
                  work = num1 // ', got ' // num2
                  call kdebug(packets,'Bad Checksum, needed ',work)
              else
                  recpack = char(type)
              endif
              rlen = p                    !Note the end of the packet
              rovrhd = rovrhd - len       !Adjust overhead for data count
              return
          endif

      end do

      ErrMsg = 'Illegally formed packet'
      recpack = '!'            !!!!If we got here, we ran out of data

      return
      end

      integer*2 function ctl(b)                          ,<890525.1144>
     >Make controls printable
      implicit none

c     Toggle the 7th bit of a byte such that CTRL-A <--> A

      integer*2 b

      ctl = ixor(b,64)

      return
      end

      subroutine pPutc(b)                                ,<890525.1144>
     >Store a packet-data byte
      implicit none

      include kercom.ftni,NOLIST
      integer*2 b

      p1ata(p) = char(b)                  !Store the byte
      p = p + 1                           !...and count it

      return
      end

      subroutine recpar(len)                             ,<890525.1144>
     >Save other's parameters
      implicit none

      include kercom.ftni,NOLIST
      include kercnf.ftni,NOLIST          !Defines fRmx
      integer*2 len
      integer*2 pblocksize
      parameter (pblocksize = 9)
      integer*2 sdefs(pblocksize)         !Remote default parameters
      integer*2 unchar,ctl,pgetc,i,b,maxp

      Data sdefs /                        !Set default remote parameters
     >            80,                     !Maximum packet = 80 bytes
     >            30,                     !receive timeout = 30 seconds
     >            0,                      !no padding required
     >            0,                      !(padding uses nulls)
     >            13,                     !<CR> terminates a packet
     >            35,                     !Control-quoting uses "#"
     >            32,                     !No 8th-bit prefixing will be done
     >            1,                      !1-byte checksums
     >            32/                     !No repeat-counts will be done

      call MoveWords(sdefs,sPkSiz,pblocksize) !Set remote defaults
      call Set_Timeout(R,sTime*100,fRmx)  !Preset remote timeout
      NewChk = 1                          !Reset default checksum type
      p = 5                               !Start with the MAXL field
      fBit8 = .false.                     !No 8th-bit stuff unless agreed
      fRepC = .false.                     !No repeat-count unless agreed
      maxp = rlen - 1                     !Get last param pos (w/ checkt=1)

      do i = 1,pblocksize                 !parse each parameter field
          if (p .gt. maxp) then           !Past end of received data?
              sPcnt = i - 1               !Save # of parameters passed
              return
          endif
          b = ichar(R1cPkt(p))            !Get a parameter byte
          if (b .eq. 0) return            !Done?
          p = p + 1                       !bump the byte pointer

          if (i .eq. 1) then              !Packet size?
              sPkSiz = min(94,unchar(b))
          else if (i .eq. 2) then         !Timeout value?
              b = unchar(b)               !Yes - get it as usual
              sTime = b                   !Copy it to parameter block
              call Set_timeout(R,b*100,fRmx) !...and set the timeout up
          else if (i .eq. 3) then
              sPad = unchar(b)
          else if (i .eq. 4) then         !Is it the pad character?
              sPadch = ctl(b)
          else if (i .eq. 5) then         !EOL character?
              sEOL = unchar(b)
          else if (i.eq.6) then           !Quote character?
              sQuote = b
          else if (i.eq.7) then           !8th-bit prefix character?
              call valBquote(b)
          else if (i.eq.8) then           !Checksum type?
              if (b.gt.48 .and. b.lt.52) NewChk = b-48   !Allow only '1'-'3'
              ChkTyp = NewChk    !>>>1.98c I'll use that checksum-type too
          else if (i.eq.9) then           !Repeat-character prefix?
              sRepc = b                   !Yes - save it
              if (b.eq.Repc .and. b.gt.32) then !If same as mine & not blank
                  fRepc = .true.          !...then we'll do it
              endif
          endif
      end do

      return
      end

      subroutine SndPar(ptype,num)                       ,<890525.1144>
     >Send my parameters
      implicit none

      include kercom.ftni,NOLIST
      integer*2 num
      integer*2 i,ctl,toChar,svCheck
      character*1 ptype

      toChar(i) = i+32                    !Raise controls to printable

      svCheck = sCheck                    !Save partner's checksum type
      sCheck = 1                          !Always send params w/ 1-byte check
      p = 1                               !Reset the packet pointer
      pdata = ' '                         !Remove the old data
      call pPutc(toChar(PakSiz))          !Send my current packet size
      call pPutc(toChar(Timeout))         !Set my timeout in
      call pPutc(toChar(nPad))            !I don't need padding
      call pPutc(ctl(Padch))              !(and my pad-character is NULL)
      call pPutc(toChar(EOLch))           !My EOL is always 13
      call pPutc(Quote)                   !Give 'em my quote character
      call pPutc(Bit8)                    !...and my 8th-bit prefix
      call pPutc(ChkTyp + 48)             !Show which checksum type I want
      call pPutc(Repc)                    !Give 'em my repeat character
      i = min(sPcnt,9)                    !Don't send too many parameters
      call SndPack(ptype,num,i)           !Now send the packet

      sCheck = svCheck                    !Restore partner's checksum type

      return
      end

      integer*2 function unchar(ch)                      ,<890525.1144>
     >Undo "TOCHAR" operation
      implicit none

      integer*2 ch

      unchar = ch - 32
      return
      end

      subroutine fClose                                  ,<890525.1144>
     >Close current s/r file
      implicit none

      include kerfil.ftni,NOLIST
      integer*2 err
      integer*4 r,p

      if (fbnry) then                     !Need to trim a type-1 transfer?
          call FmpPosition(fiCb,err,r,p)  !Yes - where are we in the file?
          call FmpTruncate(fiCb,err,r-1)  !...truncate at one record less
      endif
      call FmpClose(fiCb,err)

      return
      end

      subroutine SendAbort                               ,<890525.1144>
     >Kill all send stuff
      implicit none

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST
      integer*2 err

      call fClose
      call FmpEndMask(maCb)

c -->  More to do???

      return
      end

      subroutine success(pass)                           ,<890525.1144>
     >Print pass/fail if local
      implicit none

      include kercom.ftni,NOLIST
      logical*2 pass

      if (R .ne. L) then                  !If we are local...
          call tpFm('_')                 !Sound the bell
          call sleep(100)
          if (pass) then
              call tpFm('File transfer(s) completed')
          else
              call tpFm('File transfer(s) failed')
          endif
          call sleep(100)
          call tpFm('')                  !Beep again
      endif

      return
      end

      subroutine startstats                              ,<890525.1144>
     >Start statistics logging
      implicit none

      include kersta.ftni,NOLIST
      integer*4 timenow

c     Clear all counters associated with the 'last transfer'

      spak = 0                            !Packets sent
      rpak = 0                            !Packets received
      rtry = 0                            !# of retries (sent or received)
      sbytes = 0                          !Bytes (total) sent
      rbytes = 0                          !...and recieved
      sovrhd = 0                          !Overhead bytes sent
      rovrhd = 0                          !...and received

      startim = timenow()                 !Start the clock

      return
      end

      subroutine endstats                                ,<890525.1144>
     >End statistics logging
      implicit none

      include kersta.ftni,NOLIST
      integer*4 timenow

      trpak = trpak + rpak                !Total the packets received
      tspak = tspak + spak                !Total the packets sent
      trtry = trtry + rtry                !Total the packets retried

      endtim = timenow()                  !Stop the clock
      if (endtim .lt. startim) then       !Did we cross midnight?
          endtim = endtim + 86400J        !Yes - add a day's seconds
      endif

      return
      end

      subroutine ValBQuote(b)                            ,<890525.1144>
     >Validate BQuote param
      implicit none

      include kercom.ftni,NOLIST
      integer*2 b,BIGY,AMPERSAND
      parameter (AMPERSAND = 38)
      parameter (BIGY      = 89)

      sBit8 = b                           !Save partner's 8-th bit character
      fBit8 = .false.                     !Preset BQuote processing off
      if (.not. f8OK) return              !Don't process if user has it off

      if (b .eq. BIGY) then               !Partner wants to use my byte?
          fBit8 = .true.                  !Yes - turn it on
          if (.not. fSend) then           !If I am to receive...
              Bit8 = AMPERSAND            !...need to use default bquote
          endif
          sBit8 = Bit8                    !Set sender's BQuote to mine
          return
      endif

      if ((b.gt.32 .and. b.lt.63) .or. (b.gt.95 .and. b.lt.127)) then
          Bit8 = b                        !Remote: "Do it with this byte"
          fbit8 = .true.                  !Flag the agreement
      endif

      return
      end

      subroutine doIpacket                               ,<890525.1144>
     >Process 'I' packet
      implicit none

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST          !To define fBnry

!     This routine's purpose is to perform all of those
!         "set param value"
!     on receipt of a server I (initialize) packet.  We are currently only
!     interested in the quote, bquote, and repeat characters, and the
!     checksum type.  Note that if b-quoting is disabled and parity isn't
!     none, we will not be able transfer binary, so if that flag is on,
!     turn it off!

      Quote = sQuote                      !Set myself to partner's quote
      Bit8 = sBit8                        !...and partner's bquote
      f8OK = Bit8 .ne. 32                 !Allow binary quoting?
      ChkTyp = sCheck                     !Partner wants special checksums?
      Repc = sRepc                        !Get partner's repeat character

      if (fBnry .and. Parity.ne.3 .and. .not.f8OK) fBnry = .false.

      return
      end

      character*1 function seof(retry)                   ,<890525.1144>
     >Send the EOF packet
      implicit none

      include kercom.ftni,NOLIST
      include kerfil.ftni,NOLIST
      integer*2 retry,num,len,err,FmpOpen
      logical*2 fRetry
      character*1 ptype,RecPack
      character*4 openopts

      if ( fRetry(retry) ) then
          seof = '!'
          call SendAbort
          return
      endif

      call SndPack('Z',seq,0)             !Send the EOF packet
      seof = state                        !Assume no change in state
      ptype = RecPack(len,num)            !Get the response

      if (ptype .eq. 'T') then            !Time-out?
          return                          !just retry

      else if (ptype .eq. 'E') then       !Error packet?
          ErrMsg = 'Receiver error: ' // RecPkt(5:len+4)
          seof = 'E'
          call SendAbort
          return

      else if (ptype .eq. 'N') then       !NAK?
          if (mod(seq+1,64) .ne. num) then
              return
          else
              ptype = 'Y'
              num = num - 1
          endif
      endif

      if (ptype .eq. 'Y') then            !ACK?
          if (num .ne. seq) return
          retry = 0
          call fClose                     !Close the current file
          seq = mod(seq+1,64)             !Set next sequence number
          seof = '@'

      else                                !Unknown packet type
          ErrMsg = 'Unknown packet type: ' // ptype
          seof = '!'                      !Abort the transfer
          call SendAbort                  !Close sending/search files
      endif

      return
      end

      subroutine SndErr                                  ,<890525.1144>
     >Send error-packet
      implicit none

      include kercom.ftni,NOLIST
      integer*2 len,TrimLen

      pdata = ErrMsg
      len = TrimLen(pdata)
      if (fPkIO) then
          call SndPack('E',seq,len)       !Send error-packet
          if (R .ne. L) call tpFm(ErrMsg) !Inform local user
      else
          call tpFm(ErrMsg)
      endif

      return
      end

      subroutine sndpack(type,num,len)                   ,<890525.1144>
     >Transmit a packet
      implicit none

c     NOTE: it is assumed that asynchronous interrupts on the remote
c           LU have been disabled prior to this routine.

      include kercom.ftni,NOLIST
      include kerdbg.ftni,NOLIST
      include kersta.ftni,NOLIST

      character*1 type
      integer*2 num,len
      integer*2 i,j,check1,check2,check3
      character*1 toChar

      toChar(i) = char(i+32)          !Raise controls to printable range

      i = sPad + len + 5 + sCheck     !Compute length of packet
      sbytes = sbytes + i             !Count 'em
      sovrhd = sovrhd + i - len       !Adjust overhead for data

      if (sPad .gt. 0) then           !Need to do padding?
          do i = 1,50                 !Yes - build a pad-character buffer
              P1cket(i) = char(sPadCh)
          end do
          do i = 1,sPad,50            !Send padding in 50-byte pieces
              j = min(50,sPad-(i-1))  !Set tx count (don't overdo padding!)
              call putpak(j)
          end do
      endif

      Packet = char(sSync)                !Clear packet/install sync byte
      P1cket(2) = toChar( len+2+sCheck )  !...and the length byte
      P1cket(3) = toChar( num )           !...and the sequence number
      P1cket(4) = type                    !...and the packet type
      Packet(5:) = pData                  !...add the data part
      p = 5 + len                         !Adjust the store-pointer
      P1cket(p) = toChar(check1(P1cket,p))!Perform/store the checksum
      p = p + 1                           !Bump pointer for EOL character
      if (sCheck .ne. 1) then             !Do 2- or 3-byte checks?
          P1cket(p) = toChar(check2())    !Yes - add the 2nd byte
          p = p + 1
      endif
      if (sCheck .eq. 3) then             !Doing 3-byte CRC?
          P1cket(p) = toChar(check3())    !Yes - add last byte
          p = p + 1
      endif
      P1cket(p) = char(sEOL)              !Voila - packet is ready to send

      call kdebug(packets,'SndPack: ',packet(:p))

      call putpak(p)                      !send the packet

      spak = spak + 1                     !Count the packet

      return
      end

      integer*2 function Check1(pack,plen)               ,<890525.1144>
     >Generate checksums
      implicit none

!     When called as Check1, this function calculates the 1- or 2-byte
!     checksum or a 3-byte CRC, AS DICTATED BY MY PARTNER'S PARAMETERS!
!     The part of the packet which is subject to checking is the length
!     field through the current value of "P" (the pointer to the next
!     byte of the packet) less 1.  It is called either to encode the
!     checksum/CRC or to test it on a received packet.  The returned
!     value of Check1 is the first of a possibly multi-byte checksum or
!     CRC.  Check2 and Check3 return the remaining bytes of the 2-byte
!     checksum or 3-byte CRC as needed.  Note that the form of the 1st
!     byte of the 1- and 2-byte checksums is NOT the same!.

      include kercom.ftni,NOLIST
      character*1 pack(*)
      integer*2   plen,i,csum,b
      integer*2   check2,check3
      integer*2   x,y,crc1(0:15),crc2(0:15)
      data crc1 /
     >000000b,010201b,020402b,030603b,041004b,051205b,061406b,071607b,
     >102010b,112211b,122412b,132613b,143014b,153215b,163416b,173617b/
      data crc2 /
     >000000b,010611b,021422b,031233b,043044b,053655b,062466b,072277b,
     >106110b,116701b,127532b,137323b,145154b,155745b,164576b,174367b/

      csum = 0                            !Clear checksum accumulator

      do i = 2,plen-1                     !Checksum length thru data
          b = ichar( pack(i) )            !Get a packet byte
          if (sCheck .ne. 3) then         !Doing 1- or 2-byte checks?
              csum = csum + b
          else                            !else doing CCITT-CRC
              b = ixor(b,csum)
              x = iand(b,17b)             !Get lower nybble
              y = ibits(b,4,4)            !...and upper nybble
              b = ixor(crc2(x),crc1(y))   !Get CRC factor
              csum = ibits(csum,8,8)      !Shift off byte from previous CRC
              csum = ixor(csum,b)         !and add in new value
          endif
      enddo

      if (sCheck .eq. 1) then             !Return proper 1-byte checksum
          check1 = iand( 63,(csum + (iand(csum,192)/64)))   !Form type-1 check
      elseif (sCheck .eq. 2) then         !Return 1st of 2-byte checksum
          check1 = ibits(csum,6,6)        !...as upper 6 of 12-bit checksum
      else                                !Return 1st of 3-byte CRC
          check1 = ibits(csum,12,4)       !...as upper 4 of 16-bit CRC
      endif
      return

      entry check2()
      if (sCheck .eq. 2) then             !Return 2nd of 2-byte checksum
          check2 = iand(csum,77b)         !...as lower 6 of 12-bit checksum
      else                                !else return 2nd of 3-byte CRC
          check2 = ibits(csum,6,6)        !...as bits 6-11 of 16-bit CRC
      endif
      return

      entry check3()
      check3 = iand(csum,77b)             !Return low 6 bits of CRC
      return

      end

      subroutine get                                     ,<890525.1144>
     >Get from a server
      implicit none

      include kercom.ftni,NOLIST
      include kercmd.ftni,NOLIST
      include kerfil.ftni,NOLIST
      logical*2 succeed,receive,fRetry,fRtryi
      integer*2 retry,err,len,num,TrimLen,j
      character*1 ptype,RecPack

      retry = 0                           !Reset the retry-counter

 5    if ( fRtryi(retry) ) then           !Retry-limit exceeded?
          call tpFm('Unable to initialize on a Get command')
          return
      endif

      call SndPar('I',seq)                !Try to initialize
      ptype = RecPack(len,num)            !Get the response
      if (ptype .eq. 'Y') then            !ACK?
          if (num .ne. seq) goto 5        !Retry if out of sequence
      endif

      seq = 0                             !Reset the sequence number
      retry = 0                           !...and retry counter
      pdata = GetMask                     !Set 1st param as get's data
      j = TrimLen(pdata)                  !Get the name's length

 10   if ( fRetry(retry) ) then           !Exceeded the retry limit?
          call tpFm('Unable to GET')
          return
      endif

      call SndPack('R',seq,j)             !Send the request for files
      ptype = RecPack(len,num)            !Get the response

      if (ptype .eq. 'S') then            !Correct response is send-init
          if (num .ne. seq) goto 10
          fSend = .false.                 !Do params as a receive
          call RecPar(len)                !get partner's parameters
          if (fBnry .and. Parity.ne.3 .and. .not.fBit8) then
              ErrMsg = 'Can''t receive binary file (parity problem)'
              call SndErr
              fBnry = .false.
              return
          endif
          call SndPar('Y',seq)            !...and send mine
          sCheck = NewChk                 !Change checksum type now
          seq = mod(seq+1,64)
          succeed = receive('F')          !Try to receive
          call success(succeed)
          sCheck = 1                      !Revert to 1-byte checksums
          return
      else if (ptype .eq. 'E') then       !Error packet?
          call tpCh('Received error packet: -',RecPkt(5:len+4),0)
          return
      else if (ptype .eq. 'X') then       !Checksum error?
          call tpFm('Checksum error - retrying')
      else if (ptype .eq. 'T') then       !Time-out?
          call tpFm('<timed out>')
      else
          call tpCh('Unknown packet type: -',ptype,1)
      endif

      goto 10

      end

      subroutine IBMrd                                   ,<890525.1144>
     >Look for IBM-prompt
      implicit none

      include kercom.ftni,NOLIST
      include kercnf.ftni,NOLIST          !To define remote configuration
      include kersta.ftni,NOLIST
      integer*2 xr(2),rc
      equivalence (xr(2),rc)

      if ( fIBM ) then                    !Need to wait for PROMPT?
          xr = R
          if ( btest(iRmx,0) ) then       !D-mux?
              Rc = 100b                   !Yes - just set for binary
          else
              Rc = 1100b                  !Binary + keep type-ahead data
          endif
          p = 18                          !Yes - read at least one byte
          do while (p .ne. 17)            !Look for prompt byte
              rbytes = rbytes + 1
              rovrhd = rovrhd + 1
              call xluex(1,xr,p,-1)
              p = ishft(p,-8)             !Move byte for look for IBM-PROMPT
          end do
      endif
      return

      end

      subroutine PakIO                                   ,<890525.1144>
     >Prepare for packet-I/O
      implicit none

      include kercom.ftni,NOLIST
      include kercnf.ftni,NOLIST

      if (R .eq. L) then                  !If remote-host mode...
          call disable(R,fRmx)            !...disable scheduling
          call KillEnqAck                 !...and handshake
      endif
      call control(R,2600b,1)             !Clear all input buffers
      fPkIO = .true.
      seq = 0                             !Reset sequence#
      return

      end

      subroutine NrmIO                                   ,<890525.1144>
     >Restore from packet-I/O
      implicit none

      include kercom.ftni,NOLIST
      include kercnf.ftni,NOLIST          !Defines fRmx

      sCheck = 1                          !Revert to 1-byte checksums
      fPkIO = .false.
      if (R .eq. L) then
          call restore(R)
          call enable(R,fRmx)
      endif
      return

      end