CCCCCCCCCCCCCC  KERCOM         CCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ DELAY,EOL,ESCHAR,FD,FILNAME(132),HOSTON,
     +             IBMON,LOCALINFD,LOCALOUTFD,LOCALSLU,MAXTRY,MOREFD,
     +             MYEOL,MYPAD,MYPCHAR,MYQUOTE,N,NUMTRY,OLDTRY,
     +             PACKET(132),PAD,PADCHAR,PAKSIZ,PARITY,PROMPT,
     +             QUOTE,RECPKT(132),RMTINFD,RMTOUTFD,RMTTTY(132),
     +             RPSIZ,SBAUD,SIZE,SOH,SPARITY,SPEED,SPORT,SPSIZ,
     +             STATE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCC  KERDEF         CCCCCCCCCCCCCCCCCCCCCCC
C     DEFINES VARIOUS CONSTANTS FOR THE KERMIT-HP1000 PROGRAM
      PARAMETER (ATSIGN=64)
      PARAMETER (BACKSLASH=92)
      PARAMETER (BACKSPACE=8)
      PARAMETER (BAD=-3)
      PARAMETER (BANG=33)
      PARAMETER (BAR=124)
      PARAMETER (BIGA=65)
      PARAMETER (BIGB=66)
      PARAMETER (BIGC=67)
      PARAMETER (BIGD=68)
      PARAMETER (BIGE=69)
      PARAMETER (BIGF=70)
      PARAMETER (BIGG=71)
      PARAMETER (BIGH=72)
      PARAMETER (BIGI=73)
      PARAMETER (BIGJ=74)
      PARAMETER (BIGK=75)
      PARAMETER (BIGL=76)
      PARAMETER (BIGM=77)
      PARAMETER (BIGN=78)
      PARAMETER (BIGO=79)
      PARAMETER (BIGP=80)
      PARAMETER (BIGQ=81)
      PARAMETER (BIGR=82)
      PARAMETER (BIGS=83)
      PARAMETER (BIGT=84)
      PARAMETER (BIGU=85)
      PARAMETER (BIGV=86)
      PARAMETER (BIGW=87)
      PARAMETER (BIGX=88)
      PARAMETER (BIGY=89)
      PARAMETER (BIGZ=90)
      PARAMETER (BLANK=32)
      PARAMETER (CARET=94)
      PARAMETER (COLON=58)
      PARAMETER (COMMA=44)
      PARAMETER (CR=13)
      PARAMETER (DEL=127)
      PARAMETER (DIG0=48)
      PARAMETER (DIG1=49)
      PARAMETER (DIG2=50)
      PARAMETER (DIG3=51)
      PARAMETER (DIG4=52)
      PARAMETER (DIG5=53)
      PARAMETER (DIG6=54)
      PARAMETER (DIG7=55)
      PARAMETER (DIG8=56)
      PARAMETER (DIG9=57)
      PARAMETER (DIGIT=2)
      PARAMETER (DOLLAR=36)
      PARAMETER (DQUOTE=34)
      PARAMETER (EOF=10003)
      PARAMETER (EOS=10002)
      PARAMETER (HUGE=30000)
      PARAMETER (LETA=97)
      PARAMETER (LETB=98)
      PARAMETER (LETC=99)
      PARAMETER (LETD=100)
      PARAMETER (LETE=101)
      PARAMETER (LETF=102)
      PARAMETER (LETG=103)
      PARAMETER (LETH=104)
      PARAMETER (LETI=105)
      PARAMETER (LETJ=106)
      PARAMETER (LETK=107)
      PARAMETER (LETL=108)
      PARAMETER (LETM=109)
      PARAMETER (LETN=110)
      PARAMETER (LETO=111)
      PARAMETER (LETP=112)
      PARAMETER (LETQ=113)
      PARAMETER (LETR=114)
      PARAMETER (LETS=115)
      PARAMETER (LETT=116)
      PARAMETER (LETU=117)
      PARAMETER (LETV=118)
      PARAMETER (LETW=119)
      PARAMETER (LETX=120)
      PARAMETER (LETY=121)
      PARAMETER (LETZ=122)
      PARAMETER (LF=10)
      PARAMETER (NO=0)
      PARAMETER (OK=-2)
      PARAMETER (PERCENT=37)
      PARAMETER (PERIOD=46)
      PARAMETER (PLUS=43)
      PARAMETER (QMARK=63)
      PARAMETER (SEMICOL=59)
      PARAMETER (SHARP=35)
      PARAMETER (SLASH=47)
      PARAMETER (SQUOTE=39)
      PARAMETER (STAR=42)
      PARAMETER (STDOUT=1)
      PARAMETER (TAB=9)
      PARAMETER (TILDE=126)
      PARAMETER (UNDERLINE=95)
      PARAMETER (YES=1)
CCCCCCCCCCCCCC  HELPFI         CCCCCCCCCCCCCCCCCCCCCCC
 EXIT          - Terminates this KERMIT RTE-6/VM program.
   
 HELP          - Types out the content of this HELP file.
   
 QUIT          - Terminates this KERMIT RTE-6/VM program.
   
 RECEIVE       - Places this KERMIT RTE-6/VM program into a
               - state ready for receiving one or more file(s).
   
 SEND FILENAME - Sends the content of the file specified in
               - filename.
   
 SEND @FILENAME- Send the content of all the files specified
               - in filename; filename here is treated as a
               - directory of files to be sent.
   
 SET DELAY N   - Where N is a decmial ranging from 0 to 30.
               - Instructs this KERMIT RTE-6/VM program how many
               - seconds to wait before sending out the first
               - packet.  These time delays allows the user time
               - to get back to his/her LOCAL KERMIT program and
               - initiate the RECEIVE command.  Defaulted time
               - delay is 10 seconds.
   
 SET MYQUOTE N - Where N is a decmial ranging from 33 to 126.
               - Instructs THIS KERMIT program character to be
               - used in QUOTING control characters.  Defaulted
               - QUOTE character used is '#'.
   
 SET PACKET N  - Where N is a decmial ranging from 31 to 94.
               - It specifies the maximum packet size used
               - for file transfer.  Defaulted packet size is 80.
   
 SET SOH N     - Where N is a decmial ranging from 1 to 31.  This
               - is the START OF HEADING found in every KERMIT
               - packet.  Both KERMIT must agree to this value.
               - It need not be change for most types of file
               - transfer.  Defaulted SOH used is CNTR-A (1).
   
 STATUS        - Displays the status of user selectable parameters.
CCCCCCCCCCCCCC    &KERMI       CCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCC THIS IS THE LAST FILE, NO NEED TO LOOK FURTHER  CCCCCC
CCCCCCCCCCCCCC ALL THE SUBROUTINES CAN BE COMPILED AS ONE FILE CCCCC
FTN7X,S
$FILES(0,10)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      PROGRAM KERMIT
C     HP1000-KERMIT MAIN PROGRAM
C  
C     RTE-6/VM KERMIT was implemented by John Lee of RCA Laboratories
C     6/29/84
C  
C     Permission is granted to any individual or instution to copy
C     or use this program, except for explicitly commerical purpose.
C  
C                                               John Lee
C                                               RCA Laboratories
C                                               (609) 734-3157
C  
C     DEFINITION OF KEY GLOBAL VARIABLES FOLLOWS:
C  
C     DELAY        - # of seconds waited before sending out the first
C                  - SINIT packet ( only in remote mode).
C     EOL          - End of line delimiter required by other KERMITS.
C     ESCHAR       - The character used to return back to command parser
C                  - from 'CHAT' mode.
C     FD           - The file descriptor ( channel) of sending/receiving
C                  - file
C     FILNAME(132)-  The integer array which holds  The currrent working
C                  - filename
C     HOSTON       - Identifies whether this KERMIT is running in local
C                  - or remote mode.
C     IBMON        - Identifies whether this KERMIT is talking to an
C                  - IBM CMS system.
C     LOCALINFD    - Local (tty) input channel (login line)
C     LOCALOUTFD   - Local (tty) output channel ( login line)
C     LOCALSLU     - System session LU of logined TTY
C     MAXTRY       - Maximum number of re-try before giving up
C     MOREFD       - The file descriptor which acts as a directory of
C                  - sending file; similar to wildcard feature
C     MYEOL        - The end of line delimiter selectable by users
C     MYPAD        - The # of pad characters required by this KERMIT
C     MYPCHAR      - The pad character required by this KERMIT
C     MYQUOTE      - The quote  used for control s
C                  - by this KERMIT slectable by user
C     N            - The number of the current packet frame number
C     NUMTRY       - The number of re-try attempt so far
C     OLDTRY       - The number of re-try already attempted
C     PACKET(132)  - An integer array to hold the content of a packet
C     PAD          - The # of pad characters required by other KERMIT
C     PADCHAR      - The pad character to used if required by other KERM
C     PAKSIZ       - The maximum packet size selectable by users
C     PARITY       - One of five parity mode used in sending/receiving
C                  - data ( valid in local mode only)
C     PROMPT       - The turnaround control character this KERMIT looks
C                  - for in file transfer with IBM.
C     QUOTE        - The quote character used for control character used
C                  - by other KERMITS
C     RECPKT(132)  - An integer array which holds the incoming packet
C     RMTINFD      - The remote (TTY) input channel
C     RMTOUTFD     - The remote (TTY) output channel
C     RMTTTY(132)  - An integer array which hold the un-login line
C                  - for file-transfer.
C     RPSIZ        - maximum size of packet to be receive
C     SBAUD        - whether this system supports baud switching
C     SIZE         - maximum size of data packet to be sent
C     SOH          - The start of header used in sending packet; selecta
C                  - by user
C     SPARITY      - whether this system supports parity switching
C     SPEED        - Baud rate of the REMOTE TTY line
C     SPORT        - whether this system supports remote line switching
C     SPSIZ        - Maximum size of packet to be used for sending
C     STATE        - Current state of file transfer processs
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      COMMON /IOUNIT/ PT,BUFFCHAN(10),MAXCHAN
      COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,VXONXOFF,
     +             VREST
C     SET DEFAULT PARAMETERS
      INTEGER*2 ALIN(132),BLIN(132)
      INTEGER*2 STATUS,GETLIN,FCHAN,ITEMP
C  
      DELAY=10            ! 10 SECONDS
      EOL=13              ! CR
      ESCHAR=29           ! CNTR-]
      HOSTON=YES          ! we are running in Remote Host mode
      IBMON=NO
      LOCALINFD=1         !DEFAULT STANDARD INPUT CHANNEL FOR HP1000
      LOCALOUTFD=1        !DEFAULT STANDARD OUTPUT CHANNEL FOR HP1000
      MAXTRY=5
      MYEOL=13
      MYPAD=0
      MYPCHAR=0
      MYQUOTE=35
      PAD=0
      PADCHAR=0
      PAKSIZ=80
      PARITY=1
C                           1=EVEN, 2=ODD 3=SPACE 4=MARK 5=NONE
      PROMPT=17           !DC1, IBM MODE ONLY
      QUOTE=35
      SOH=1
      SPEED=9600          !9600 BAUD
      STATE=BIGC
C     SET DEFAULT NON-LOGIN TTY ( IN LOCAL MODE ONLY)
      RMTTTY(1)=BIGA
      RMTTTY(2)=BIGB
      RMTTTY(3)=BIGC
      RMTTTY(4)=BIGD
      RMTTTY(5)=BIGE
      RMTTTY(6)=BIGF
      RMTTTY(7)=LF
      RMTTTY(8)=EOS
C  
      SPARITY=YES
      SBAUD=YES
      SPORT=NO
      VREST=52004B   !7 bits/char; baud rate generaor 1;1 stop bits
      VRAWCOOK=400B  !set tty to cook mode
      VXONXOFF=1     !set XON/XOFF enabled
      VENQACK=0      !set ENQ/ACK disabled
C  
C     initialized chanel stack
C  
      MAXCHAN=10
      PT=1
      FCHAN=1       !HP1000 first non-defaulted channel start with 1
      DO 1 I=PT,MAXCHAN
         BUFFCHAN(I)=FCHAN+I
1     CONTINUE
C     determine whether we are running in Remote or Local KERMIT mode
         HOSTON = YES             !remote kermit in effect
         WRITE(1,99)
         WRITE(1,100)
         RMTINFD=LOCALINFD
         RMTOUTFD=LOCALOUTFD
      CALL PARSER
99    FORMAT(' ','RTE-6/VM KERMIT Version 1.0')
100   FORMAT(' ','Remote Host KERMIT mode now in effect')
101   format(' ','Local KERMIT mode now in effect')
      STOP
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION AOPEN(FNAME,MODE)
C  
C     JL 4/25/84 13:53
C  
C  
      INTEGER*2 FNAME(1),MODE
      INTEGER*2 X,Y,XREAD,XWRITE,IOS,GETCHAN
      INTEGER*2 TFILE(132),INAME(3)
      INTEGER*2 MAXLEN,COUNT
C  
$INCLUDE KERDEF
      MAXLEN=6            !max. filename length in HP1000
      COUNT=1
      XREAD=0
      XWRITE=1
C  
      DO WHILE((FNAME(COUNT).NE.LF).AND.    !determine the length of fil
     +         (FNAME(COUNT).NE.EOS).AND.
     +         (FNAME(COUNT).NE.0))
         TFILE(COUNT)=FNAME(COUNT)
         COUNT=COUNT+1
      END DO
C  
      IF(COUNT.LE.MAXLEN)THEN               !file filename with trailing
         DO WHILE(COUNT.LE.MAXLEN)          !blanks
            TFILE(COUNT)=BLANK
            COUNT=COUNT+1
         END DO
      ENDIF
C  
      TFILE(MAXLEN+1)=EOS
      CALL PACK(TFILE,INAME)
C  
C  
      IF(MODE.EQ.XREAD)THEN                 !we want read access
         X=GETCHAN(Y)                       !get a channel
         IF(X.EQ.BAD)THEN                   !is there any more
            WRITE (1) 'all channels have been allocated'
            AOPEN=BAD
            RETURN
         ENDIF
         OPEN(UNIT=X,IOSTAT=IOS,ERR=88,FILE=INAME,STATUS='OLD')
C        see 3-86 of FORTRAN 77 Reference Manual
         AOPEN=X
         RETURN
88       CONTINUE                           !file does not existed
         CALL PUTCHAN(X)                    !returned the allocated
         AOPEN=BAD                          !channel
         RETURN
      ELSE IF(MODE.EQ.XWRITE)THEN           !we want write access
              CALL REMOVE(FNAME)            !remove that file and ignore
              X=GETCHAN(Y)                  !error, get a channel
              IF(X.EQ.BAD)THEN
                 WRITE (1) 'all channels have been allocated'
                 AOPEN=BAD
                 RETURN
              ENDIF
      OPEN(UNIT=X,STATUS='NEW',FILE=INAME,IOSTAT=IOS,ERR=99)
C             See page 3-86 of FORTRAN 77 Reference Manual
              AOPEN=X
              RETURN
99            CONTINUE
              CALL PUTCHAN(X)
              AOPEN=BAD
              RETURN
      ELSE
          WRITE (1) 'Invalid read/write mode detected'
          AOPEN=BAD
          RETURN
      ENDIF
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE BUFEMP(BUFFER,LEN)
C  
C     JL 4/18/84 14:30
C  
C     write out the content of the buffer out to the receiving disk file
C     BUFFER is an integer array which holds the data
C     LEN tells how many bytes are there in this buffer array
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 BUFFER(132),LEN,CH,CTL,I,T
C  
      CH=FD                           !file descriptor of receiving disk
      I=1                             !start with the very first charact
      DO WHILE(I.LE.LEN)              !put LEN characters into disk file
         T=BUFFER(I)                  !get the next character from buffe
         IF(T.EQ.MYQUOTE)THEN         !is this my quote character
            I=I+1                     !increment the counter
            T=BUFFER(I)               !get next character from buffer
            IF(T.NE.MYQUOTE)T=CTL(T)  !is this quote character the
                                      !actual QUOTE character
         ENDIF
         IF(T.NE.LF)CALL DPUTCH(T,CH) !filter out LF
         I=I+1
      END DO
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION BUFILL(BUFFER)
C  
C     JL 4/18/84 14:30
C  
C     fill up the buffer with character byte from the sending disk file
C     BUFFER is used to stored the data from the sending disk file
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 I,CTL,DGETCH,BUFFER(132),CH
C  
      I=1
      CH=FD                                !file descriptor of the sendi
                                           !disk file
      DO WHILE ((DGETCH(T,CH).NE.EOF))     !keep reading byte from the d
                                           !file until we reach an EOF,o
                                           !we have enough byte to fill
                                           !buffer, return from within t
                                           !directly
         IF((T.LT.BLANK).OR.(T.EQ.DEL).OR.(T.EQ.QUOTE))THEN
             IF(T.EQ.LF)THEN               !it is the line delimiter of
                BUFFER(I)=QUOTE            !this system, insert the LF
                I=I+1                      !before the CR
                BUFFER(I)=CTL(CR)
                I=I+1
             ENDIF
             BUFFER(I)=QUOTE               !we got a character that
             I=I+1                         !quoting
             IF(T.NE.QUOTE)T=CTL(T)
         ENDIF
         BUFFER(I)=T
         I=I+1
         IF(I.GT.(SPSIZ-8))THEN      !read up to spsiz-8 byte from disk
            BUFILL=I-1               !I byte was read
            RETURN
         ENDIF
      END DO
      IF(I.EQ.1)THEN
        BUFILL=EOF                   !zero byte was read
        RETURN
      ELSE
        BUFILL=I-1                   !partial EOF was detected
        RETURN
      ENDIF
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE CHTOIN(CSTRING,ISTRING,ILENGTH)
C  
C     JL 4/18/84  14:45
C  
C     converts a character string into an integer array, using only the
C     the last 7 bits, also added an extra EOS into the end of the
C     integer array string
C  
C     CSTRING is the character string
C     ISTRING is the integer array which will hold the new string
C     ILENGTH tell how long the character string is
C  
C  
      CHARACTER*1 CSTRING(1)
      INTEGER*2 ISTRING(1),ILENGTH
C  
      DO I=1,ILENGTH
         ISTRING(I)=IAND(ICHAR(CSTRING(I)),177B)
      END DO
C  
      ISTRING(ILENGTH+1)=EOS
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION CTOI(IN, I)
      INTEGER*2 IN(1)
      INTEGER*2 I, S
$INCLUDE KERDEF
23000 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23001
      I = I + 1
      GOTO 23000
23001 CONTINUE
      IF(.NOT.(IN(I) .EQ. 45 .OR. IN(I) .EQ. 43))GOTO 23002
      S = IN(I)
      I = I + 1
      GOTO 23003
23002 CONTINUE
      S = 0
23003 CONTINUE
      CTOI = 0
23004 IF(.NOT.(IN(I) .NE. 10002))GOTO 23006
      IF(.NOT.(IN(I) .LT. 48 .OR. IN(I) .GT. 57))GOTO 23007
      GOTO 23006
23007 CONTINUE
      CTOI = 10 * CTOI + IN(I) - 48
23005 I = I + 1
      GOTO 23004
23006 CONTINUE
      IF(.NOT.(S .EQ. 45))GOTO 23009
      CTOI = -CTOI
23009 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION CTL(T)
C  
C     JL 4/18/83 14:50
C  
C     toggle the control bit of a character so that
C     CNTR-A becomes A and vice versa
C  
      INTEGER*2 T
C  
      CTL=IXOR(T,64)  !do a exclusive OR on the control bit which is
                      !the seventh th bit
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION DGETCH(XCHAR,CH)
C  
C     JL 4/25/84 14:20
C  
C     get a CHAR from the disk file
C  
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 XCHAR,CH
      COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
      INTEGER*2 X,DGETLIN
$INCLUDE KERDEF
C  
      IF(XEOF.EQ.YES)THEN
         DGETCH=EOF
         RETURN
      ENDIF
      IF(XNEW.EQ.YES)THEN
         X=DGETLIN(XLIN,CH)
         IF(X.EQ.EOF)THEN
            DGETCH=EOF
            XEOF=YES
            RETURN
         ELSE
            IF(XLIN(1).EQ.LF)THEN
               XNEW=YES
               DGETCH=OK
               XCHAR=LF
               RETURN
            ELSE
               XNEW=NO
               DGETCH=OK
               XCHAR=XLIN(1)
               XCOUNT=2
               RETURN
            ENDIF
        ENDIF
      ELSE
          IF(XLIN(XCOUNT).EQ.LF)THEN
             XNEW=YES
             DGETCH=OK
             XCHAR=LF
             RETURN
           ELSE
              DGETCH=OK
              XCHAR=XLIN(XCOUNT)
              XCOUNT=XCOUNT+1
              RETURN
           ENDIF
      ENDIF
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION DGETLIN(ALIN,CH)
C  
C     JL 5/10/84 11:25
C  
      INTEGER*2 ALIN(132),CH
      INTEGER*2 BLIN(132),ACOUNT,BCOUNT,STATUS,TV1
      INTEGER*2 IOS,TV2
      INTEGER*2 MLEFT,MRIGHT
$INCLUDE KERDEF
C  
      MLEFT=77400B
      MRIGHT=177B
      DO I=1,130
         BLIN(I)=0
         ALIN(I)=0
      END DO
      READ(UNIT=CH,IOSTAT=IOS,END=999)BLIN
      IF(IOS.NE.496)THEN
         DGETLIN=EOF
         RETURN
      ENDIF
C  
      STATUS=YES
      ACOUNT=1
      BCOUNT=1
C  
      DO I=1,65
C        TAKE OUT THE LEFT BYTE
         TV1=IAND(BLIN(I),MLEFT)
         ALIN(ACOUNT)=ISHFT(TV1,-8)
C        TAKE OUT THE RIGHT BYTE
         ACOUNT=ACOUNT+1
         TV1=IAND(BLIN(I),MRIGHT)
         ALIN(ACOUNT)=TV1
         ACOUNT=ACOUNT+1
      END DO
C    UNPACK THE INPUT LINE
C    TAKE OUT TRAILING BLANKS
      ACOUNT=130
      STATUS=YES
       DO WHILE(STATUS.EQ.YES)
        IF(ACOUNT.EQ.0)THEN
           ALIN(1)=LF
           ALIN(2)=EOS
           DGETLIN=OK
           RETURN
         ENDIF
         IF((ALIN(ACOUNT).EQ.0).OR.(ALIN(ACOUNT).EQ.BLANK))THEN
            ACOUNT=ACOUNT-1
         ELSE
            ALIN(ACOUNT+1)=LF
            ALIN(ACOUNT+2)=EOS
            DGETLIN=OK
            RETURN
         ENDIF
      END DO
999   CONTINUE
      DGETLIN=EOF
      RETURN
177   FORMAT(' ','VALUE OF IOS IN DGETLIN ERROR ',I5)
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE DPUTCH(XCHAR,CH)
C  
C     JL 4/25/84 14:25
C  
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 XCHAR,CH
      COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
$INCLUDE KERDEF
C  
      IF(XCHAR.EQ.CR)THEN
         XLIN(XCOUNT)=LF
         XLIN(XCOUNT+1)=EOS
         CALL DPUTLIN(XLIN,CH)
         XCOUNT=1
         RETURN
      ELSE
          XLIN(XCOUNT)=XCHAR
          XCOUNT=XCOUNT+1
          RETURN
      ENDIF
      RETURN
      END
C     output a char to the disk file channel
C  
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE DPUTLIN(ALIN,CH)
C  
C     JL 5/11/84 10:00
C  
C     write alin to a disk file
C  
      INTEGER*2 ALIN(132),CH,IOS,ACOUNT,BLEN
      CHARACTER*1 BLIN(130)
      INTEGER*2 XCR
$INCLUDE KERDEF
C  
      ACOUNT=1
      XCR=CR
      DO WHILE(ALIN(ACOUNT).NE.LF)
                BLIN(ACOUNT)=CHAR(ALIN(ACOUNT))
                ACOUNT=ACOUNT+1
      END DO
      BLEN=ACOUNT-1
C  
      WRITE(UNIT=CH,FMT=100,IOSTAT=IOS,ERR=900)(BLIN(I)(1:1),I=1,BLEN)
100   FORMAT(130A1)
      RETURN
900   CONTINUE
      WRITE(1,901)IOS
901   FORMAT(' ','VALUE OF IOS IN DPUTLIN IS ',I5)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION FINDLN(LIN,APAT,A1,Z1)
C  
C     JL 4/18/84  14:50
C  
C     This function will try to find the pattern within a line
C     it also returns the value of where the pattern begins and where
C     the patterns ends.  A1 initially tells this subroutine where to st
C     looking, the return value of A1 tells the calling program where th
C     pattern begins and Z1 tells the calling program where the pattern
C     EOS is not counted in the Z1 value when return to calling program.
C     return status of YES means pattern is found
C     return status of NO means pattern in not found
C  
C     LIN is an integer array that holds the line to search upon
C     APAT is an integer array that holds the pattern to search with
C  
      INTEGER*2 LIN(1),APAT(1),A1,Z1,STATUS,T1,T2,T3,FLAG
C  
$INCLUDE KERDEF
      STATUS=OK
      T1=A1
      DO WHILE(STATUS.EQ.OK)  !do forever, exit initiate from within loo
C  
         DO WHILE((LIN(T1).NE.APAT(1)).AND.(LIN(T1).NE.EOS))
C  
            T1=T1+1   !keep searching until the first character of the
                      !pattern matches a character in the line
                      !exit if we reach the EOS in the line
         END DO
         IF(LIN(T1).EQ.EOS)THEN   !we hit EOS on the line, no match
            STATUS=NO
         ELSE
             A1=T1
             T2=1
             T3=T1
             FLAG=NO
             DO WHILE((FLAG.EQ.NO).AND.(APAT(T2).NE.EOS)) !perform
                                                          !incremental
                                                          !matching
                IF(APAT(T2).EQ.LIN(T1))THEN
                   T1=T1+1
                   T2=T2+1
                ELSE
                    FLAG=YES    !we got partial matching , no exact
                ENDIF
             END DO
             IF(APAT(T2).EQ.EOS)THEN
                Z1=T1-1
                STATUS=YES
             ELSE
                T1=T3+1
             ENDIF
          ENDIF
      END DO
      FINDLN=STATUS
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION GETCHAN(CHAN)
C  
C     JL 4/25/84 13:35
C  
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /IOUNIT/ PT, BUFFCHAN(10), MAXCHAN
C  
C  
$INCLUDE KERDEF
      IF(PT.GT.MAXCHAN)THEN
         GETCHAN=BAD            !already used-up all available channels
      ELSE
          GETCHAN=BUFFCHAN(PT)  !there are more available channels
          PT=PT+1
      ENDIF
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION GETLIN(ALIN,CH)
C  
C     JL 5/8/84 10:40 AM
C  
C     read a line from the channel and unpack them
C  
C  
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 ALIN(1),CH
      INTEGER*2 BLIN(132),ICODE,ICNWD,ILEN,STATUS,TV1,TV2
      INTEGER*2 WHICHS,LEFT,RIGHT,MLEFT,MRIGHT,ACOUNT,BCOUNT
      INTEGER*2 IA,IB
C  
      COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
     +             VXONXOFF,VREST
$INCLUDE KERDEF
C      INITIALIZED THE ALIN ARRAY
       DO I=1,132
          BLIN(I)=0
          ALIN(I)=0
       END DO
      LEFT=1
      RIGHT=2
      WHICHS=LEFT
      MLEFT=077400B
      MRIGHT=000177B
      ICODE=1+140000B
      ILEN=-130
      IF(VRAWCOOK.EQ.400B)THEN
         ICNWD=CH+400B
      ELSE
         ICNWD=CH
      ENDIF
      ACOUNT=1
      BCOUNT=1
C  
      CALL EXEC(ICODE,ICNWD,BLIN,ILEN,*100)
C     UNPACK THE INPUT LINE
      STATUS=YES
      DO WHILE(STATUS.EQ.YES)
         IF(WHICHS.EQ.RIGHT)THEN
            TV1=IAND(BLIN(BCOUNT),MRIGHT)
            IF(TV1.EQ.0)THEN
               ALIN(ACOUNT)=LF
               ALIN(ACOUNT+1)=EOS
               GETLIN=OK
               RETURN
            ELSE
               ALIN(ACOUNT)=TV1
               ACOUNT=ACOUNT+1
               BCOUNT=BCOUNT+1
               WHICHS=LEFT
            ENDIF
         ELSE
             TV1=IAND(BLIN(BCOUNT),MLEFT)
             TV2=ISHFT(TV1,-8)
             IF(TV2.EQ.0)THEN
                ALIN(ACOUNT)=LF
                ALIN(ACOUNT+1)=EOS
                GETLIN=OK
                RETURN
             ELSE
                ALIN(ACOUNT)=TV2
                WHICHS=RIGHT
                ACOUNT=ACOUNT+1
             ENDIF
          ENDIF
       END DO
       RETURN
100    GETLIN=EOF
       RETURN
       END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION IBMGETLIN(BUFFER,CH)
C  
C     JL 4/18/84 15:00
C  
C     read a packet with a SOH in it and wait for the prompt
C     before returning it
C  
C     BUFFER is an integer array that will hold the incoming packet
C     CH tells this routine which channel to read the packet from
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 BUFFER(132),CH,STATUS,GASOH,COUNT,T,IBYTE
      INTEGER*2 TGETCH,X
C  
      STATUS=YES
      GASOH=NO                          !we have not gotten a packet yet
      COUNT=1
      DO WHILE(STATUS.EQ.YES)
          DO WHILE(GASOH.EQ.NO)          !keep reading one byte at a tim
            IBYTE=0                     !the I/O port until you see the
            X=TGETCH(IBYTE,CH)          !character , EOF is not expected
            IF(IBYTE.EQ.SOH)THEN
               GASOH=YES                !I got the SOH
               BUFFER(COUNT)=IBYTE      !store the SOH into buffer
               COUNT=COUNT+1            !increment the buffer pointer
            ENDIF
          END DO
          IBYTE=0
          X=TGETCH(IBYTE,CH)            !read a byte from the I/O port
          IF(IBYTE.EQ.PROMPT)THEN       ! we got the prompt
             STATUS=NO
          ELSE
              BUFFER(COUNT)=IBYTE       !it is not a prompt, but another
              COUNT=COUNT+1             !data of the incoming packet
          ENDIF                         !store it and increment pointer
      END DO
      BUFFER(COUNT)=EOS                 !add an EOS into end of buffer
      IBMGETLIN=OK
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION KGETLIN(BUFFER,CH)
C  
C     JL 4/18/84 15:00
C  
C     read a packet with a SOH in it and DON'T wait for the prompt
C     before returning it
C  
C     BUFFER is an integer array that will hold the incoming packet
C     CH tells this routine which channel to read the packet from
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 BUFFER(132),CH,STATUS,GASOH,COUNT,T,IBYTE
      INTEGER*2 TGETCH,X
C  
      STATUS=YES
      GASOH=NO                          !we have not gotten a packet yet
      COUNT=1
      DO WHILE(STATUS.EQ.YES)
          DO WHILE(GASOH.EQ.NO)          !keep reading one byte at a tim
            IBYTE=0                     !the I/O port until you see the
            X=TGETCH(IBYTE,CH)          !character , EOF is not expected
            IF(IBYTE.EQ.SOH)THEN
               GASOH=YES                !I got the SOH
               BUFFER(COUNT)=IBYTE      !store the SOH into buffer
               COUNT=COUNT+1            !increment the buffer pointer
            ENDIF
          END DO
          IBYTE=0
          X=TGETCH(IBYTE,CH)            !read a byte from the I/O port
          IF(IBYTE.EQ.MYEOL)THEN        !we got the required MYEOL
             STATUS=NO
          ELSE
              BUFFER(COUNT)=IBYTE       !it is not MYEOL, but another
              COUNT=COUNT+1             !data of the incoming packet
          ENDIF                         !store it and increment pointer
      END DO
      BUFFER(COUNT)=EOS                 !add an EOS into end of buffer
      KGETLIN=OK
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE PACK(XFROM,XTO)
C  
C     JL 5/2/84 10:38
C  
C     pack the integer array of XFROM into the array of XTO
C     with the right side of byte ending with a BLANK in case
C     where there are odd number of bytes.  This PACK routine is
C     used mainly used for file convention in the HP1000
C  
      INTEGER*2 XFROM(1),XTO(1)
      INTEGER*2 WHICHS,LEFT,RIGHT,FCOUNT,TCOUNT,TV
C  
$INCLUDE KERDEF
      LEFT=0
      RIGHT=1
      WHICHS=LEFT       !the next byte to pack belongs to the left side
      FCOUNT=1          !start with the first word of the XFROM array
      TCOUNT=1          !start with the first word of the XTO array
C  
      DO WHILE(XFROM(FCOUNT).NE.EOS)   !keep doing until EOS is detected
         IF(WHICHS.EQ.LEFT)THEN
            TV=ISHFT(XFROM(FCOUNT),8)  !shift left by 8 bits
            XTO(TCOUNT)=0
            XTO(TCOUNT)=TV+40B
            WHICHS=RIGHT               !the next byte to pack belongs
                                       !to the right side
         ELSE
             TV=IAND(XTO(TCOUNT),77400B)  !mask out the right sided bla
             XTO(TCOUNT)=IOR(TV,XFROM(FCOUNT))  !perform logical sum
             WHICHS=LEFT               !the next byte to pack belongs to
                                       !the left side
             TCOUNT=TCOUNT+1           !incremeted the pointer of the
                                       !XTO array
         ENDIF
         FCOUNT=FCOUNT+1               !incremeted the pointer of the
                                       !XFROM array
      END DO
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE PARSER
C  
C     JL 4/18/84 17:00
C  
C     the main parser at the command level
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2   ICONNECT(8),IEXIT(5),IHELP(5),IQUIT(5)
      INTEGER*2   IRECEIVE(8),ISET(4)
      INTEGER*2   ISEND(5),ISTATUS(7)
C  
      INTEGER*2 ALIN(132),BLIN(132)
      INTEGER*2 TV,STATUS,A1,Z1
      INTEGER*2 GETLIN,FINDLN
C  
      DATA  ICONNECT /67,79,78,78,69,67,84,10002/
      DATA IEXIT /69,88,73,84,10002/
      DATA IHELP /72,69,76,80,10002/
      DATA IQUIT /81,85,73,84,10002/
      DATA IRECEIVE /82,69,67,69,73,86,69,10002/
      DATA ISET /83,69,84,10002/
      DATA ISEND /83,69,78,68,10002/
      DATA ISTATUS /83,84,65,84,85,83,10002/
C     initialize keyword character string
C  
C  
C     convert character string to integer array with an EOS at end
C     of the integer array
C  
C     do forever
C  
      STATUS=YES
C  
      DO WHILE(STATUS.EQ.YES)
         WRITE(1,188)
         WRITE (1) 'KERMIT RTE-6/VM>'
         TV=GETLIN(ALIN,LOCALINFD)       !read a line from local keyboar
         CALL UPPER(ALIN,BLIN)           !converts it to uppercase
         A1=1
         FLAG1=FINDLN(BLIN,ICONNECT,A1,Z1)   !search for keyword CONNECT
         A1=1
         FLAG2=FINDLN(BLIN,IEXIT,A1,Z1)      !search for keyword EXIT
         A1=1
         FLAG3=FINDLN(BLIN,IHELP,A1,Z1)      !search for keyword HELP
         A1=1
         FLAG4=FINDLN(BLIN,IQUIT,A1,Z1)      !search for keyword QUIT
         A1=1
         FLAG5=FINDLN(BLIN,IRECEIVE,A1,Z1)   !search for keyword RECEIVE
         A1=1
         FLAG6=FINDLN(BLIN,ISET,A1,Z1)       !search for keyword SET
         A1=1
         FLAG7=FINDLN(BLIN,ISEND,A1,Z1)      !search for keyword SEND
         A1=1
         FLAG8=FINDLN(BLIN,ISTATUS,A1,Z1)    !search for keyword STATUS
C  
         IF(FLAG1.EQ.YES)THEN                !it is the keyword CONNECT
            CALL SCONNECT
         ELSE IF(FLAG2.EQ.YES)THEN           !it is the keyword QUIT
                 CALL SQUIT
         ELSE IF(FLAG3.EQ.YES)THEN           !it is the keyword HELP
                 CALL SHELP
         ELSE IF(FLAG4.EQ.YES)THEN           !it is the keyword QUIT
                 CALL SQUIT
         ELSE IF(FLAG5.EQ.YES)THEN           !it is the keyword RECEIVE
                 CALL SRECEIVE
         ELSE IF(FLAG6.EQ.YES)THEN           !it is the keyword SET
                 CALL SSET(BLIN)
         ELSE IF(FLAG7.EQ.YES)THEN           !it is the keyword SEND
                 CALL SSEND(BLIN)
         ELSE IF(FLAG8.EQ.YES)THEN           !it is the keyword STATUS
                 CALL SSTATUS
         ELSE
             WRITE (1) 'Unrecognized command  type "HELP"'
         ENDIF
       END DO
C  
      RETURN
188   FORMAT(' ')
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE PUTCHAN(CHAN)
C  
C     JL 4/25/84 13:35
C  
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /IOUNIT/ PT, BUFFCHAN(10), MAXCHAN
C  
C  
$INCLUDE KERDEF
      IF(PT.EQ.1)RETURN       !no channel was allocated at all
      PT=PT-1
      BUFFCHAN(PT)=CHAN
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE PUTLIN(ALIN,CH)
C  
C     JL 4/25/84 14:15
C  
C     output a line ot the specific channel
C  
C  
      INTEGER*2 ALIN(1),CH
      INTEGER*2 LEFT,RIGHT,WHICHS,STATUS,ACOUNT,BCOUNT
      INTEGER*2 TCOUNT
      INTEGER*2 BLIN(132),TV1,TV2,XCR
      INTEGER*2 ICODE,ICNWD,ILEN
C  
$INCLUDE KERDEF
      LEFT=1
      RIGHT=2
      XCR=CR
      WHICHS=LEFT
      ACOUNT=1
      BCOUNT=1
      ICODE=2+140000B
      ICNWD=CH
      TCOUNT=1
C  
      DO WHILE(ALIN(ACOUNT).NE.LF)
         IF(WHICHS.EQ.LEFT)THEN
            TV1=ISHFT(ALIN(ACOUNT),8)
            BLIN(BCOUNT)=0
            BLIN(BCOUNT)=TV1+40B
            WHICHS=RIGHT
         ELSE
             TV1=IAND(BLIN(BCOUNT),77400B)
             BLIN(BCOUNT)=IOR(TV1,ALIN(ACOUNT))
             WHICHS=LEFT
             BCOUNT=BCOUNT+1
         ENDIF
         ACOUNT=ACOUNT+1
         TCOUNT=ACOUNT
      END DO
C  
      IF(WHICHS.EQ.LEFT)THEN
         BLIN(BCOUNT)=CR+40B
         TCOUNT=TCOUNT-1
         IF(TCOUNT.EQ.0)THEN
            BLIN(1)=CR+40B
            TCOUNT=1
         ENDIF
         ILEN=-TCOUNT
         CALL EXEC(ICODE,ICNWD,BLIN,ILEN,*100)
      ELSE
          TV1=IAND(BLIN(BCOUNT),77400B)
          BLIN(BCOUNT)=IOR(TV1,XCR)
          TCOUNT=TCOUNT-1
          ILEN=-TCOUNT
          CALL EXEC(ICODE,ICNWD,BLIN,ILEN,*100)
      ENDIF
      RETURN
100   CONTINUE
      WRITE (1) 'ERROR IN PUTLIN SUBROUTINE'
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE RATCLOSE(CH)
C  
C     JL 4/25/84 13:50
C  
C     close that channel and return it to the channel pool
C  
      INTEGER*2 CH,IOS
$INCLUDE KERDEF
      CALL PUTCHAN(CH)
      CLOSE(CH)
C     see page 5-16 of FORTRAN 77 Reference Manual
      RETURN
999   CONTINUE
      WRITE(1,100)CH
100   FORMAT(' ','error in closing this channel ',I4)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RDATA(X)
C  
C     JL 4/18/84 15:05
C  
C     read a data packet from the other KERMIT
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 NUM,LEN,STATUS,X,RPACK,TNUM
      INTEGER*2 TV1,TV2,TV3,TV4
C  
      IF(NUMTRY.GT.MAXTRY)THEN
         RDATA=BIGA                   !exceeded maxtry , gives up
         CALL RATCLOSE(FD)
         RETURN
      ELSE
          NUMTRY=NUMTRY+1             !try it again
      ENDIF
      STATUS=RPACK(LEN,NUM,PACKET)    !read a packet
      IF(HOSTON.EQ.NO)THEN            !if we are running in remote
         WRITE(1,100)NUM              !mode the diepay packet #
      ENDIF
      IF(STATUS.EQ.BIGD)THEN          !we got the data packet
         IF(NUM.NE.N)THEN
            IF(OLDTRY.GT.MAXTRY)THEN
               RDATA=BIGA
               CALL RATCLOSE(FD)
               RETURN
            ELSE
                OLDTRY=OLDTRY+1
            ENDIF
            IF(NUM.EQ.(N-1))THEN
               CALL SPAR(PACKET)      !we got a duplicted packet
               TV1=BIGY               !just ACK it
               TV2=6
               CALL SPACK(TV1,NUM,TV2,PACKET)
               NUMTRY=0
               RDATA=STATE
               RETURN
            ELSE
                RDATA=BIGA
                CALL RATCLOSE(FD)
                RETURN
            ENDIF
         ENDIF
         CALL BUFEMP(PACKET,LEN)     !write the data packet just receive
         TNUM=N                      !into the receiving disk file
         TV1=BIGY
         TV2=TNUM
         TV3=0
         TV4=0
         CALL SPACK(TV1,TV2,TV3,TV4) !ACK the just received packet
         OLDTRY=NUMTRY
         NUMTRY=0
         N=MOD((N+1),64)
         RDATA=BIGD
         RETURN
      ELSE IF(STATUS.EQ.BIGF)THEN        !the packet is the file header
              IF(OLDTRY.GT.MAXTRY)THEN   !we should have already gotten
                 RDATA=BIGA              !exceeded number of retry, give
                 CALL RATCLOSE(FD)
                 RETURN
              ELSE
                  OLDTRY=OLDTRY+1
              ENDIF
              IF(NUM.EQ.(N-1))THEN       !we got duplicate file header p
                 TV1=BIGY
                 TV2=0
                 TV3=0
                 CALL SPACK(TV1,NUM,TV2,TV3)  !just ACK it
                 NUMTRY=0
                 RDATA=STATE
                 RETURN
              ELSE
                  RDATA=BIGA
                  CALL RATCLOSE(FD)
                  RETURN
              ENDIF
      ELSE IF(STATUS.EQ.BIGZ)THEN             !we got the EOF packet
              IF(NUM.NE.N)THEN
                 RDATA=BIGA
                 CALL RATCLOSE(FD)
                 RETURN
              ENDIF
              TNUM=N
              TV1=BIGY
              TV2=0
              TV3=0
              CALL SPACK(TV1,TNUM,TV2,TV3)  !ACK it
              CALL RATCLOSE(FD)             !close the receiving disk fi
              N=MOD((N+1),64)
              RDATA=BIGF                    !change the state to look fo
              RETURN                        !another file header
      ELSE IF(STATUS.EQ.BAD)THEN
              RDATA=STATE                   !there was an error in the
              TNUM=N                        !checksum
              TV1=BIGN
              TV2=0
              TV3=0
              CALL SPACK(TV1,TNUM,TV2,TV3)  !NAK it
              RETURN
      ELSE
          RDATA=BIGA                     !we got a unknown packet type
          CALL RATCLOSE(FD)
      ENDIF                              !gives up
      RETURN
100   FORMAT(' ','Packet # ',I4)
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RECSW(X)
C  
C     JL 4/18/84 17:06
C  
C     receive a file or a group of file from the other KERMIT
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
      INTEGER*2 X,RDATA,RFILE,RINIT,STATUS
      INTEGER*2 TV1,TV2,TV3,TV4
C  
      STATUS=YES
      STATE=BIGR
      XNEW=YES
      XCOUNT=1
      N=0
      NUMTRY=0
      DO WHILE(STATUS.EQ.YES)
               IF(STATE.EQ.BIGD)THEN                !read a DATA packet
                  STATE=RDATA(X)
               ELSE IF(STATE.EQ.BIGR)THEN           !read a SINIT packet
                       STATE=RINIT(X)
               ELSE IF(STATE.EQ.BIGF)THEN           !read a file header
                       STATE=RFILE(X)
               ELSE IF(STATE.EQ.BIGC)THEN           !file transfer compl
                       RECSW=YES
                       RETURN
               ELSE IF(STATE.EQ.BIGA)THEN           !we got an error
                       RECSW=NO
                       TV1=BIGE
                       TV2=N
                       TV3=0
                       TV4=0
                       CALL SPACK(TV1,TV2,TV3,TV4)  !send an ERROR packe
                       RETURN                       !file channel
               ENDIF
      END DO
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE REMOVE(FNAME)
C  
C     JL 4/25/84 13:43
C  
C  
      INTEGER*2 FNAME(1),TFILE(7),IDCB1(144),IERR
      INTEGER*2 INAME(3),COUNT,MAXLEN,XLENGTH
C  
$INCLUDE KERDEF
      MAXLEN=6               !HP1000 have a max. filename length of 6
      COUNT=1
C  
      DO WHILE((FNAME(COUNT).NE.LF).AND.    !determine length of filenam
     +         (FNAME(COUNT).NE.EOS))
         TFILE(COUNT)=FNAME(COUNT)
         COUNT=COUNT+1
      END DO
C  
      IF(COUNT.LE.MAXLEN)THEN               !fill up rest with trailing
         DO WHILE(COUNT.LE.MAXLEN)
            TFILE(COUNT)=BLANK
            COUNT=COUNT+1
         END DO
      ENDIF
C                                           !pack the filename string
      TFILE(MAXLEN+1)=EOS
      CALL PACK(TFILE,INAME)
      OPEN(40,FILE=INAME,STATUS='OLD',ERR=111)
      CLOSE(40,STATUS='DELETE')
      RETURN
111   CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RFILE(X)
C  
C     JL 4/18/84 17:08
C  
C     read a file header packet from the other KERMIT
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 NUM,LEN,STATUS,RPACK,X,TNUM,AOPEN
      INTEGER*2 TV1,TV2,TV3,TV4,XWRITE
C  
      XWRITE=1
      IF(NUMTRY.GT.MAXTRY)THEN
         RFILE=BIGA                          !exceeded max. # of re-try
         RETURN                              !gives up
      ELSE
          NUMTRY=NUMTRY+1
      ENDIF
      STATUS=RPACK(LEN,NUM,PACKET)
      IF(STATUS.EQ.BIGS)THEN                 !we got a SINIT packet
         IF(OLDTRY.GT.MAXTRY)THEN
            RFILE=BIGA                       !re-try it again
            RETURN
         ELSE
             OLDTRY=OLDTRY+1
         ENDIF
         IF(NUM.EQ.(N-1))THEN                !we already got the SINIT
            CALL SPAR(PACKET)                !packet, get my file-transf
            TV1=BIGY                         !requirement/parameters
            TV2=6
            CALL SPACK(TV1,NUM,TV2,PACKET)   !ACK it
            NUMTRY=0
            RFILE=STATE
            RETURN
         ELSE
             RFILE=BIGA                      !unexpected sequence #
             RETURN                          !gives up
         ENDIF
      ELSE IF(STATUS.EQ.BIGZ)THEN            !we got a EOF packet
              IF(OLDTRY.GT.MAXTRY)THEN
                 RFILE=BIGA                  !exceeded max # of re-try
                 RETURN                      !gives up
              ELSE
                  OLDTRY=OLDTRY+1            !re-try one more time
              ENDIF
              IF(NUM.EQ.(N-1))THEN
                 TV1=BIGY                    !we already got the EOF pac
                 TV2=0
                 TV3=0
                 CALL SPACK(TV1,NUM,TV2,TV3) !just ACK it
                 NUMTRY=0
                 RFILE=STATE
                 RETURN
              ELSE
                  RFILE=BIGA                 !unexpected sequence #
                  RETURN
              ENDIF
      ELSE IF(STATUS.EQ.BIGF)THEN            !we got the file header pac
              IF(NUM.NE.N)THEN
                 RFILE=BIGA                  !unexpected sequence #,give
                 RETURN
              ENDIF
              PACKET(LEN+1)=LF               !packet(len) has the incomi
              PACKET(LEN+2)=EOS              !filename packet
              CALL VERIFY(PACKET)            !verify the incoming filena
                                             !is valid, otherwise make i
                                             !valid within this system
              IF(HOSTON.EQ.NO)THEN
                 WRITE (1) 'Receiving file--> '
                 CALL PUTLIN(PACKET,LOCALOUTFD) !display the incoming fi
              ENDIF
              FD=AOPEN(PACKET,XWRITE)        !open that file for writing
              IF(FD.EQ.BAD)THEN
                 RFILE=BIGA                  !we got a ERR in opening th
                 RETURN
              ENDIF
              TNUM=N
              TV1=BIGY
              TV2=0
              TV3=0
              CALL SPACK(TV1,TNUM,TV2,TV3)   !ACK the file header packet
              OLDTRY=NUMTRY
              NUMTRY=0
              N=MOD((N+1),64)
              RFILE=BIGD                    !change state to look for DA
              RETURN                        !packet
      ELSE IF(STATUS.EQ.BIGB)THEN           !we got a BREAK transmission
              IF(NUM.NE.N)THEN
                 RFILE=BIGA
                 RETURN
              ENDIF
              TNUM=N
              TV1=BIGY
              TV2=0
              TV3=0
              CALL SPACK(TV1,TNUM,TV2,TV3) !ACK the BREAK packet
              RFILE=BIGC                   !change state to complete sta
              RETURN
      ELSE IF(STATUS.EQ.BAD)THEN           !we got an error on the check
              RFILE=STATE
              TNUM=N
              TV1=BIGN
              TV2=0
              TV3=0
              CALL SPACK(TV1,TNUM,TV2,TV3) !NAK it
              RETURN
      ELSE
          RFILE=BIGA                       !unexpected packet type, give
      ENDIF
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RINIT(X)
C  
C     JL 4/18/84 17:10
C  
C     receive the initial packet from the remote KERIT
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 LEN,NUM,STATUS,RPACK,X,TNUM
      INTEGER*2 TV1,TV2,TV3,TV4
C  
      IF(NUMTRY.GT.MAXTRY)THEN
         RINIT=BIGA                           !exceeded max. # of re-try
         RETURN                               !gives up
      ELSE
          NUMTRY=NUMTRY+1                     !try-it again
      ENDIF
      DO I=1,40
         PACKET(I)=0
      END DO
      STATUS=RPACK(LEN,NUM,PACKET)            !read a packet
      IF(STATUS.EQ.BIGS)THEN                  !we got a SINIT packet
         CALL RPAR(PACKET)                    !store other KERMIT's requ
         CALL SPAR(PACKET)                    !get our parameters/requir
         TNUM=N
         TV1=BIGY
         TV2=6
         CALL SPACK(TV1,TNUM,TV2,PACKET)      !send out requirement and
         OLDTRY=NUMTRY                        !ACK it on one shot
         NUMTRY=0
         N=MOD((N+1),64)
         RINIT=BIGF                           !change state to look for
         RETURN                               !the file header packet
      ELSE IF(STATUS.EQ.BAD)THEN              !we got a checksum error
           RINIT=STATE
           TNUM=N
           TV1=BIGN
           TV2=0
           TV3=0
           CALL SPACK(TV1,TNUM,TV2,TV3)       !NAK it
           RETURN
      ELSE
          RINIT=BIGA                          !we got an unexpected pack
      ENDIF                                   !type, gives up
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RPACK(LEN,NUM,XDATA)
C  
C     JL 4/18/84 17:10
C  
C     read a packet from other KERMIT
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 LEN,NUM,CH
      INTEGER*2 GETLIN,IBMGETLIN
      INTEGER*2 XDATA(1)
      INTEGER*2 I,COUNT,STATUS,UNCHAR,J,K,T1,XCOUNT
      INTEGER*2 TV1,TV2,TV3
      INTEGER*2 BUFFER(132),CHKSUM,XTYPE,GAPTRY,MGAPTRY
C  
      CH=RMTINFD                           !this is the input channel to
                                           !a packet from
      GAPTRY=1
      MGAPTRY=2
      CHKSUM=0
C  
C     read me a packet that begins with a SOH and ends with MYEOL
C  
      DO WHILE(GAPTRY.LE.MGAPTRY)
         IF(IBMON.EQ.YES)THEN
            STATUS=IBMGETLIN(BUFFER,CH)    !get a packet and waits for t
         ELSE                              !prompt
            STATUS=GETLIN(BUFFER,CH)       !get a packet without waitin
         ENDIF                             !for a prompt
         COUNT=1
C  
C        skips all other characters until we see one with a SOH in it
C  
         DO WHILE((BUFFER(COUNT).NE.SOH).AND.(BUFFER(COUNT).NE.EOS))
            COUNT=COUNT+1                  !wait for a SOH or EOS
         END DO
         IF(BUFFER(COUNT).EQ.SOH)THEN      !we got the SOH
C  
C           we got a line that begins with a SOH
C  
            K=COUNT+1
            CHKSUM=BUFFER(K)
            LEN=UNCHAR(BUFFER(K))-3        !get the length of the packet
            K=K+1
            CHKSUM=CHKSUM+BUFFER(K)
            NUM=UNCHAR(BUFFER(K))          !get the sequence number of
                                           !the frame packet
            K=K+1
            XTYPE=BUFFER(K)                !get the data type
            CHKSUM=CHKSUM+BUFFER(K)
            K=K+1
C  
C           get the data
C  
C           ZERO OUT THE XDATA ARRAY
            DO I=1,132
               XDATA(I)=0
            END DO
            DO J=1,LEN
               XDATA(J)=BUFFER(K)
               CHKSUM=CHKSUM+BUFFER(K)
               K=K+1
               COUNT=J
            END DO
C  
            XDATA(COUNT+1)=EOS
            T=BUFFER(K)
C  
C           calculate the checksum of the incoming packet
C  
            TV1=IAND(CHKSUM,192)
            TV2=TV1/64
            TV3=CHKSUM+TV2
            CHKSUM=IAND(TV3,63)
C  
C           does the checksum matches
C  
            IF(CHKSUM.NE.UNCHAR(T))THEN
               RPACK=BAD                   !bad checksum
               RETURN
            ELSE
                RPACK=XTYPE
   
                RETURN
            ENDIF
         ENDIF
C  
C        we got the EOS, the packet has no SOH, read another one
C  
         GAPTRY=GAPTRY+1
      END DO
      RPACK=BAD
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE RPAR(XDATA)
C  
C     JL 4/18/84 17:13
C  
C     store the other KERMIT's file transfer requirement away
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 XDATA(1),UNCHAR,CTL
C  
      IF(XDATA(1).EQ.0)THEN               !if the other KERMIT did not s
         SPSIZ=PAKSIZ                     !any parameters, default them
                                          !our setting; otherwise use wh
                                          !the other KERMITs sends
      ELSE
           SPSIZ=UNCHAR(XDATA(1))
      ENDIF
      IF(XDATA(3).NE.0)PAD=UNCHAR(XDATA(3))
      IF(XDATA(4).NE.0)PADCHAR=CTL(XDATA(4))
      IF(XDATA(5).NE.0)EOL=UNCHAR(XDATA(5))
      IF(XDATA(6).NE.0)QUOTE=XDATA(6)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SBREAK(X)
C  
C     JL 4/18/84 17:15
C  
C     send the break packet to signify the end of transmissions
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 NUM,LEN,RPACK,STATUS,X,TNUM
      INTEGER*2 TV1,TV2,TV3
C  
      IF(NUMTRY.GT.MAXTRY)THEN
         SBREAK=BIGA                             !exceeded max. # of re-
         RETURN                                  !gives up
      ELSE
          NUMTRY=NUMTRY+1                        !try it again
      ENDIF
C  
      TNUM=N
      TV1=BIGB
      TV2=0
      TV3=0
      CALL SPACK(TV1,TNUM,TV2,TV3)
      STATUS=RPACK(LEN,NUM,RECPKT)
C  
      IF(STATUS.EQ.BIGN)THEN                     !we got a NAK packet
         IF(N.NE.(NUM-1))THEN
            SBREAK=STATE
            RETURN
          ENDIF
      ELSE IF(STATUS.EQ.BIGY)THEN                !we got a ACK packet
              IF(N.NE.NUM)THEN
                 SBREAK=STATE                    !but it is out of seque
                 RETURN
              ENDIF
              NUMTRY=0
              N=MOD((N+1),64)
              SBREAK=BIGC                        !change state to comple
              RETURN                             !status
      ELSE IF(STATUS.EQ.BAD)THEN
              SBREAK=STATE
              RETURN
      ELSE
           SBREAK=BIGA                           !receive unknown packet
      ENDIF                                      !type or error packet
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SCONNECT
C  
C     JL 4/27/84 11:30
C  
C     put this terminal into CHAT mode
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 IBUF,ILEN,TV,IWRITE,IESCHAR,STATUS,IA,IB
      INTEGER*2 IFUNC,ICLAS,LUTERM,TLEN,RMTRAW,LOCALRAW
      INTEGER*2 TCODE
C  
      STATUS=YES
      IESCHAR=ISHFT(ESCHAR,8)
      TCODE=17
      CALL SETRAW(RMTINFD,RMTTTY)
      CALL SETPAR(RMTINFD,RMTTTY)
      CALL SETBAUD(RMTINFD,RMTTTY)
      CALL SETPORT(RMTINFD,RMTTTY)
C  
      WRITE(1,101)
      WRITE(1,102)ESCHAR
C  
      ILEN=-1
      TLEN=-1
      IWRITE=2
      RMTRAW=RMTOUTFD+2000B
      LOCALRAW=LOCALOUTFD+2000B
      CALL EXEC(TCODE,LOCALINFD,IBUF,ILEN,LOCALINFD,0,ICLAS)
      CALL EXEC(TCODE,RMTINFD,IBUF,ILEN,RMTINFD,0,ICLAS)
      ICLAS=IOR(ICLAS,20000B)
C  
      DO WHILE(STATUS.EQ.YES)
         CALL EXEC(21,ICLAS,IBUF,TLEN,LUTERM)
         WRITE(1,333)LUTERM
333      FORMAT(' ','VALUE OF LUTERM IS ',I5)
         WRITE(1,334)IBUF
334      FORMAT(' ','VALUE OF IBUF READ IS ',I5)
         IF(LUTERM.EQ.LOCALINFD)THEN
            TV=IAND(IBUF,77400B)
            IF(TV.EQ.IESCHAR)THEN
               WRITE(1,103)
               CALL SETCOOK(RMTINFD,RMTTTY)
               RETURN
            ENDIF
            IF(IBMON.EQ.YES)THEN
               CALL EXEC(IWRITE,LOCALRAW,IBUF,-1,*100)
            ENDIF
            CALL EXEC(IWRITE,RMTRAW,IBUF,-1,*100)
            CALL EXEC(TCODE,LOCALINFD,IBUF,ILEN,LOCALINFD,0,ICLAS)
         ELSE
             CALL EXEC(IWRITE,LOCALRAW,IBUF,-1,*100)
             CALL EXEC(TCODE,RMTINFD,IBUF,ILEN,RMTINFD,0,ICLAS)
         ENDIF
      END DO
C  
100   CONTINUE
      CALL ABREG(IA,IB)
      WRITE(1,104)
      WRITE(1,105)IA,IB
      RETURN
101   FORMAT(' ','To exit from CHAT mode; type the')
102   FORMAT(' ','equalivent control character of ',I4)
103   FORMAT(' ','Returning to KERMIT-HP1000')
104   FORMAT(' ','Error in performing EXEC write in SCONNECT')
105   FORMAT(' ','Value of IA & IB are ',A2,' = ',A2)
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SCOPY(XFROM,I,XTO,J)
C  
      INTEGER*2 XFROM(1),XTO(1),I,J,K1,K2
C  
$INCLUDE KERDEF
      K2=J
      K1=I
C  
      DO WHILE(XFROM(K1).NE.EOS)
         XTO(K2)=XFROM(K1)
         K2=K2+1
         K1=K1+1
      END DO
C  
      XTO(K2)=EOS
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SDATA(X)
C  
C     JL 4/18/84 17:15
C  
C     sends a data packet to other KERMIT
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 X,NUM,LEN,BUFILL,STATUS,RPACK,TNUM,TV1
C  
      IF(NUMTRY.GT.MAXTRY)THEN
         SDATA=BIGA
         CALL RATCLOSE(FD)
         CALL RATCLOSE(MOREFD)
         RETURN
      ELSE
          NUMTRY=NUMTRY+1
      ENDIF
C  
      TNUM=N
      TV1=BIGD
      CALL SPACK(TV1,TNUM,SIZE,PACKET)     !send that data packet
      IF(HOSTON.EQ.NO)THEN                 !if we are running in local
          WRITE(1,100)TNUM   !mode , display the current sequence #
      ENDIF
C  
      STATUS=RPACK(LEN,NUM,RECPKT)         !get the reply
C  
C     the next statements is to make sure we are not one packet
C     ahead of other KERMIT, it will happen if other KERMIT send a NAK
C     (due to time-out detection feature) before we send the first
C     SINIT packet
C  
      IF((STATUS.EQ.BIGY).AND.(N.EQ.(NUM+1)))THEN
          STATUS=RPACK(LEN,NUM,RECKPT)
      ENDIF
C  
      IF(STATUS.EQ.BIGN)THEN               !we got a NAK
         IF(N.NE.(NUM-1))THEN
            SDATA=STATE                    !to the right sequence #, tyr
            RETURN
          ENDIF
      ELSE IF(STATUS.EQ.BIGY)THEN          !we got a ACK
              IF(N.NE.NUM)THEN
                 SDATA=STATE               !but, it was for the last pac
                 RETURN
              ENDIF
              NUMTRY=0
              N=MOD((N+1),64)              !increment frame sequence num
              SIZE=BUFILL(PACKET)          !fill up more data onto buffe
              IF(SIZE.EQ.EOF)THEN          !we got EOF on the sending
                 SDATA=BIGZ                !disk file, change state so t
                 RETURN                    !we can sent ane EOF packet
              ENDIF
              SDATA=BIGD                   !we send the DATA packet, sen
              RETURN
      ELSE IF(STATUS.EQ.BAD)THEN           !we got a checksum error
              SDATA=STATE                  !try it again
              RETURN
      ELSE
           SDATA=BIGA                      !we got unknown packet type o
           CALL RATCLOSE(MOREFD)
           CALL RATCLOSE(FD)
           RETURN
      ENDIF                                !an error type packet
      RETURN
100   FORMAT(' ','Packet # ',I4)
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SENDSW(X)
C  
C     JL 4/18/84 17:15
C  
C     send this group of file
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
      COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
C  
      INTEGER*2 XSTATUS,SDATA,SFILE,SEOF,SINIT,SBREAK
      INTEGER*2 TV1,TV2,TV3,TV4
C  
      STATE=BIGS
      XNEW=YES
      XCOUNT=1
      XEOF=NO
      N=0
      NUMTRY=0
      STATUS=YES
C  
      DO WHILE(STATUS.EQ.YES)
               IF(STATE.EQ.BIGD)THEN                 !send a data packet
                  STATE=SDATA(X)
               ELSE IF(STATE.EQ.BIGF)THEN            !send a file header
                       STATE=SFILE(X)
               ELSE IF(STATE.EQ.BIGZ)THEN            !send a EOF header
                       STATE=SEOF(X)
               ELSE IF(STATE.EQ.BIGS)THEN            !send a SINIT packe
                       STATE=SINIT(X)
               ELSE IF(STATE.EQ.BIGB)THEN            !send a BREAK packe
                       STATE=SBREAK(X)
               ELSE IF(STATE.EQ.BIGC)THEN
                       SENDSW=YES                    !file transfer comp
                       RETURN
               ELSE IF(STATE.EQ.BIGA)THEN            !file transfer fail
                       SENDSW=NO
                       TV1=BIGE
                       TV2=N
                       TV3=0
                       TV4=0
                       CALL SPACK(TV1,TV2,TV3,TV4)  !send a ERROR packet
                       RETURN
                ELSE
                     STATUS=NO
                     SENDSW=NO                      !file transfer failu
                ENDIF
      END DO
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SEOF(X)
C  
C     JL 4/18/84 17:16
C  
C     send an EOF packet to the other KERMIT
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 NUM,LEN,STATUS,RPACK,X,TNUM,TEMP,XY
      INTEGER*2 ALIN(132),AONE,BONE,TV1,TV2,TV3,TV4
      INTEGER*2 XREAD
C  
      XREAD=0
C  
      IF(NUMTRY.GT.MAXTRY)THEN
         SEOF=BIGA                       !exceeded max. # of re-try, giv
         CALL RATCLOSE(FD)
         CALL RATCLOSE(MOREFD)
         RETURN
      ELSE
          NUMTRY=NUMTRY+1
      ENDIF
C  
      AONE=1
      BONE=1
      TNUM=N
      TV1=BIGZ
      TV2=0
      TV3=0
      CALL SPACK(TV1,TNUM,TV2,TV3)       !send an EOF packet to other KE
      STATUS=RPACK(LEN,NUM,RECPKT)       !what is its reply ??
C  
      IF(STATUS.EQ.BIGN)THEN             !we got an NAK
         IF(N.NE.(NUM-1))THEN            !if NAK for last packet
            SEOF=STATE
            RETURN
         ENDIF
      ELSE IF(STATUS.EQ.BIGY)THEN        !we got a NAK
              IF(N.NE.NUM)THEN
                 SEOF=STATE              !but it was for the last packet
                 RETURN
              ENDIF
              NUMTRY=0
              CALL RATCLOSE(FD)          !close the sending disk file ch
              N=MOD((N+1),64)
              TEMP=DGETLIN(FILNAME,MOREFD) !is there another file to be pr
              IF(TEMP.EQ.EOF)THEN        !no, all the file in the direct
                 CALL RATCLOSE(MOREFD)   !have been processed, close tha
                 SEOF=BIGB               !change state to break transmis
                 RETURN
              ELSE
                  FD=AOPEN(FILNAME,XREAD) !there is at least one more fil
                                         !to be send, but does it existe
                  IF(FD.EQ.BAD)THEN      !NO, it does not existed
                     IF(HOSTON.EQ.NO)THEN
                        WRITE (1)  'file not found--> '
                        CALL PUTLIN(FILNAME,LOCALOUTFD)
                     ENDIF
                     TEMP=YES
                     DO WHILE(TEMP.EQ.YES)  !try the next filname
                        XY=DGETLIN(ALIN,MOREFD)
                        IF(X.EQ.EOF)THEN    !no more file to be processe
                           SEOF=BIGB        !change state to sent BREAK
                           CALL RATCLOSE(MOREFD) !close the directory ch
                           RETURN
                        ELSE
                            CALL SCOPY(ALIN,AONE,FILNAME,BONE)
C  
C                           there is at least one more file to be sent
C  
                            FD=AOPEN(FILNAME,XREAD) !does file existed
                            IF(FD.NE.BAD)TEMP=NO   !file does existed
                        ENDIF
                     END DO
                     SEOF=BIGF
                     RETURN
                  ELSE
                       SEOF=BIGF                 !Yes, change state to s
                       RETURN                    !the file header packet
                  ENDIF
             ENDIF
      ELSE IF(STATUS.EQ.BAD)THEN                 !there was a checksum e
              SEOF=STATE                         !try it again
              RETURN
      ELSE
           SEOF=BIGA                             !we got an unexpected p
           CALL RATCLOSE(FD)
           CALL RATCLOSE(MOREFD)
           RETURN
                                                 !or error packet, abort
                                                 !transfer mode
      ENDIF
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SETBAUD(CH,FNAME)
C  
C     JL 4/27/84 11:16
C  
C     set a global varialbe to selected baud rate, it will not
C     goes into affect until executed by SETPORT routine, then it
C     will remain in effect for the rest of the session
C  
$INCLUDE KERCOM
      COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
     +             VXONXOFF,VREST
C  
$INCLUDE KERDEF
      IF(SPEED.EQ.300)THEN
         VBAUD=60B
      ELSE IF(SPEED.EQ.1200)THEN
              VBAUD=70B
      ELSE IF(SPEED.EQ.2400)THEN
              VBAUD=110B
      ELSE IF(SPPED.EQ.4800)THEN
              VBAUD=120B
      ELSE IF(SPEED.EQ.9600)THEN
              VBAUD=130B
      ELSE
          WRITE(1,100)
      ENDIF
      RETURN
100   FORMAT(' ','Invalid baud rate; not supported in HP1000')
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SETCOOK(CH,FNAME)
C  
C     JL 4/27/84 11:05
C  
C     set a global variable to cook mode to be used later by
C     sequential read in TGETCH function routine, have no effect
C     on the tty setting itself
C  
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
     +             VXONXOFF,VREST
C  
$INCLUDE KERDEF
      VRAWCOOK=400B
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SETPAR(CH,FNAME)
C  
C     JL 4/27/84 11:12
C  
C     set a global variable to selected parity bit, it will not
C     go into affect until it is executed by the SETPORT subroutine
C     it will remain in effect for the rest of the session
C  
$INCLUDE KERCOM
      COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
     +             VXONXOFF,VREST
$INCLUDE KERDEF
C  
      IF(PARITY.EQ.1)THEN
         VPARITY=600B
      ELSE IF(PARITY.EQ.2)THEN
              VPARITY=100B
      ELSE IF(PARITY.EQ.5)THEN
              VPARITY=200B
      ELSE
          WRITE(1,100)
      ENDIF
      RETURN
100   FORMAT(' ','Invalid parity; not supported in HP1000')
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SETPORT(CH,FNAME)
C  
C     JL 4/27/84 11:20
C  
C     this routine would normally enable a user to selected which
C     port to used for remote file transfer, but it will not
C     be implemeted in the HP1000 system.  This routine is instead
C     being used for setting the proper port configuration such as
C     baud rate, parity, xon/xoff,enq/ack, stop bits, bpc etc
C  
$INCLUDE KERCOM
      COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
     +             VXONXOFF,VREST
$INCLUDE KERDEF
C  
      INTEGER*2 CH,FNAME(1)
      INTEGER*2 ICODE,ICNWD,IPARM1,IA,IB
C  
      WRITE(1) 'INSIDE THE SETPORT ROUTINE'
      ICODE=3
      ICNWD=CH+3000B
      IPARM1=VPARITY+VBAUD+VENQACK+VREST
C  
      CALL EXEC(ICODE,ICNWD,IPARM1)  !set port ID based on selected bits
      CALL ABREG(IA,IB)              !see page 2-23 of multiplex manual
      WRITE(1,100)IA,IB
      IPARM1=VXONXOFF
      ICNWD=CH+3400B
      CALL EXEC(ICODE,ICNWD,IPARM1)  !set port configuration to enable
      CALL ABREG(IA,IB)              !XON/XOFF see pages 2-23 of mult. m
      WRITE(1,100)IA,IB
100   FORMAT(' ','Values of IA & IB in SETPORT are ',A2,' = ',A2)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SETRAW(CH,FNAME)
C  
C     JL 4/27/84 11:05
C  
C     set a global variable to raw mode to be used later by
C     sequential read in TGETCH function routine, have no effect
C     on the tty setting itself
C  
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
     +             VXONXOFF,VREST
C  
$INCLUDE KERDEF
      VRAWCOOK=100B
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SFILE(X)
C  
C     JL 4/18/84 17:19
C  
C     send the filename to other KERMIT
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
      COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
C  
      INTEGER*2 NUM,LEN,COUNT,RPACK,BUFILL,X,TNUM
      INTEGER*2 TV1,TV2,ALIN(132),AONE,BONE
C  
      AONE=1
      BONE=1
      CALL SCOPY(FILNAME,AONE,ALIN,BONE)
C  
      IF(HOSTON.EQ.NO)THEN
         WRITE (1) 'Sending file--> '              !we are in local mode  dis
         CALL PUTLIN(ALIN,LOCALOUTFD)         !the filename being send
      ENDIF
C  
      IF(NUMTRY.GT.MAXTRY)THEN
         SFILE=BIGA                           !exceeded max. # of re-try
         CALL RATCLOSE(FD)
         CALL RATCLOSE(MOREFD)
         RETURN                               !gives up
      ELSE
          NUMTRY=NUMTRY+1                     !try it one more time
      ENDIF
C  
      LEN=1
      DO WHILE(FILNAME(LEN).NE.EOS)            !determine the length of f
         LEN=LEN+1
      END DO
C  
      LEN=LEN-2                               !len is the length of file
      TNUM=N
      TV1=BIGF
      CALL SPACK(TV1,TNUM,LEN,FILNAME)         !send filename to other KE
      STATUS=RPACK(LEN,NUM,RECPKT)
C  
      IF(STATUS.EQ.BIGN)THEN                  !we got a NAK
         IF(N.NE.(NUM-1))THEN
            SFILE=STATE
            RETURN
         ENDIF
      ELSE IF(STATUS.EQ.BIGY)THEN             !we got a ACK
           IF(N.NE.NUM)THEN
              SFILE=STATE
              RETURN
           ENDIF
           NUMTRY=0
           N=MOD((N+1),64)
           XNEW=YES
           XCOUNT=1
           XEOF=NO
           SIZE=BUFILL(PACKET)               !fill up a buffer full of b
           SFILE=BIGD                        !change state to sent data
           RETURN
      ELSE IF(STATUS.EQ.BAD)THEN             !we got a checksum error
              SFILE=STATE
              RETURN
      ELSE
           SFILE=BIGA                        !we got an error or unexpec
           CALL RATCLOSE(MOREFD)             !CLOSE DIRECTORY CH
           CALL RATCLOSE(FD)                 !CLOSE SENDING FD
           RETURN                            !packet type
      ENDIF
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SHELP
C  
C     JL 4/18/84 17:20
C  
C     types out the content of the helpfile
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 STATUS,GETLIN,ALIN(132),TFILE(132),TEMPCH,XREAD
      INTEGER *2 AOPEN
C  
      TFILE(1)=BIGH
      TFILE(2)=BIGE
      TFILE(3)=BIGL
      TFILE(4)=BIGP
      TFILE(5)=BIGF
      TFILE(6)=BIGI
      TFILE(7)=LF
      TFILE(8)=EOS
      XREAD=0
C  
      TEMPCH=AOPEN(TFILE,XREAD)   ! open the HELP file for reading
C  
      IF(TEMPCH.EQ.BAD)THEN
         WRITE (1) 'File containing HELP information is not available'
         RETURN
      ELSE
          DO WHILE(DGETLIN(ALIN,TEMPCH).NE.EOF)
             CALL PUTLIN(ALIN,LOCALOUTFD)
          END DO
          CALL RATCLOSE(TEMPCH)   !close the helpfile channel
      ENDIF
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SINIT(X)
C  
C     JL 4/18/84 17:20
C  
C     send an initial packet for the first connection
C     state what my parameters are
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 NUM,LEN,STATUS,RPACK,X,TNUM,TEMP,XY
      INTEGER*2 ALIN(132),AONE,BONE,TV1,TV2,XREAD
      INTEGER*2 MOREFILE(132),DGETLIN
C  
      MOREFILE(1)=BIGM
      MOREFILE(2)=BIGO
      MOREFILE(3)=BIGR
      MOREFILE(4)=BIGE
      MOREFILE(5)=BIGF
      MOREFILE(6)=BIGI
      MOREFILE(7)=LF
      MOREFILE(8)=EOS
      XREAD=0
C  
      IF(NUMTRY.GT.MAXTRY)THEN
         SINIT=BIGA                       !exceeded max # of re-try , gi
         RETURN
      ELSE
          NUMTRY=NUMTRY+1                 !try it again
      ENDIF
C  
      AONE=1
      BONE=1
      CALL SPAR(PACKET)                   !get my requirement parameters
      TNUM=N
      TV1=BIGS
      TV2=6
      CALL SPACK(TV1,TNUM,TV2,PACKET)     !send my parameters requiremen
      STATUS=RPACK(LEN,NUM,RECPKT)        !what was the reply ??
C  
      IF(STATUS.EQ.BIGN)THEN              !NAK it
         IF(N.NE.(NUM-1))THEN
            SINIT=STATE                   !try it again
            RETURN
         ENDIF
      ELSE IF(STATUS.EQ.BIGY)THEN         !ACK it
              IF(N.NE.NUM)THEN            !but it was for the previous p
                 SINIT=STATE              !re-try it again
                 RETURN
              ENDIF
              CALL RPAR(RECPKT)           !get the packet reqirement of
                                          !other KERMIT if provided
              NUMTRY=0
              N=MOD((N+1),64)
              MOREFD=AOPEN(MOREFILE,XREAD) !open the directory file chan
              IF(MOREFD.EQ.BAD)THEN        !directory file does not exis
                 SINIT=BIGA
                 RETURN
              ENDIF
              TEMP=YES
              DO WHILE(TEMP.EQ.YES)       !keep trying until we get an e
                                          !file
                       XY=DGETLIN(ALIN,MOREFD)  !DGET a filename from the
                                               !directory file
                       IF(XY.EQ.EOF)THEN       !we have reach an EOF
                          SINIT=BIGA           !nothing to send at all
                          CALL RATCLOSE(MOREFD) !close the directory fil
                          RETURN
                       ELSE
                           CALL SCOPY(ALIN,AONE,FILNAME,BONE) !we get a f
                           FD=AOPEN(FILNAME,XREAD)   !open file for readi
                           IF(FD.NE.BAD)TEMP=NO     !yes it does
                       ENDIF
              END DO
              SINIT=BIGF           !change state to sent file header pac
              RETURN
      ELSE IF(STATUS.EQ.BAD)THEN   !checksum error detected
              SINIT=STATE          !try it again
              RETURN
      ELSE
           SINIT=BIGA
      ENDIF
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SKIPBL(LIN, I)
      INTEGER*2 LIN(1)
      INTEGER*2 I
23000 IF(.NOT.(LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9))GOTO 23001
      I = I + 1
      GOTO 23000
23001 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SPAR(XDATA)
C  
C     JL 5/4/84 15:00
C  
$INCLUDE KERCOM
      INTEGER*2 CTL,TOCHAR,XZERO
      INTEGER*2 XDATA(1)
$INCLUDE KERDEF
C  
      XZERO=0
      XDATA(1)=TOCHAR(PAKSIZ)
      XDATA(2)=TOCHAR(XZERO)
      XDATA(3)=TOCHAR(XZERO)
      XDATA(4)=CTL(XZERO)
      XDATA(5)=TOCHAR(MYEOL)
      XDATA(6)=MYQUOTE
C  
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SPACK(XTYPE,NUM,LEN,XDATA)
C  
C     JL 4/18/84 17:22
C  
C     send this packet to the remote KERMIT
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 XTYPE,XDATA(1),NUM,LEN,CH
      INTEGER*2 TV1,TV2,TV3
      INTEGER*2 I,IER,COUNT,TOCHAR,CHKSUM,BUFFER(132)
C  
      CH=RMTOUTFD                     !this is the channel to send packe
      I=1                             !out on, start with the first byte
C  
      DO WHILE(I.LE.PAD)              !send out padchar if need
         CALL TPUTCH(PADCHAR,CH)
         I=I+1
      END DO
C                                     !build up the packet
      COUNT=1
      BUFFER(COUNT)=SOH
      COUNT=COUNT+1
      CHKSUM=TOCHAR(LEN+3)
      BUFFER(COUNT)=TOCHAR(LEN+3)
      COUNT=COUNT+1
      CHKSUM=CHKSUM+TOCHAR(NUM)
      BUFFER(COUNT)=TOCHAR(NUM)
      COUNT=COUNT+1
      CHKSUM=CHKSUM+XTYPE
      BUFFER(COUNT)=XTYPE
      COUNT=COUNT+1
C  
      DO I=1,LEN                     !copy the content of packet informa
         BUFFER(COUNT)=XDATA(I)      !calculate the checksum
         COUNT=COUNT+1
         CHKSUM=CHKSUM+XDATA(I)
      END DO
C  
      TV1=IAND(CHKSUM,192)
      TV2=TV1/64
      TV3=TV2+CHKSUM
      CHKSUM=IAND(TV3,63)
      BUFFER(COUNT)=TOCHAR(CHKSUM)
      COUNT=COUNT+1
      BUFFER(COUNT)=EOL
      BUFFER(COUNT+1)=EOS
      COUNT=1
      CH=RMTOUTFD
C  
      DO WHILE(BUFFER(COUNT).NE.EOS)             !send out the packet
         CALL TPUTCH(BUFFER(COUNT),CH)
         COUNT=COUNT+1
      END DO
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SQUIT
C  
C     JL 4/18/84 17:25
C  
C  
C     exit from the HPkermit program
C  
      INTEGER I
      WRITE(1,100)
100   FORMAT(' ','KERMIT-HP1000 now terminated')
      STOP
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SRECEIVE
C  
C     JL 4/30/84   15:30
C  
C     sets up TTY line before calling for RECSW routine
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
      INTEGER*2 LOGTTY(132),STATUS,AOPEN,X,BELL
C  
      BELL=7
      IF(HOSTON.EQ.YES)THEN
         CALL SETRAW(RMTINFD,LOGTTY)    !put this TTY into RAW mode
         STATUS=RECSW(X)
         CALL SETCOOK(RMTINFD,LOGTTY)   !put this TTY back into COOK mod
      ELSE
          CALL SETRAW(RMTINFD,RMTTTY)   !put this TTY into RAW mode
          CALL SETPAR(RMTOUTFD,RMTTTY)  !set user selected parity
          CALL SETBAUD(RMTOUTFD,RMTTTY) !set user selected baud rate
          CALL SETPORT(RMTINFD,RMTTTY)
          STATUS=RECSW(X)
          CALL SETCOOK(RMTINFD,RMTTTY)  !put TTY back into COOK mode
          CALL TPUTCH(BELL,LOCALSLU)
          CALL TPUTCH(BELL,LOCALSLU)
          IF(STATUS.EQ.YES)THEN
             WRITE(1,100)
          ELSE
              WRITE(1,101)
          ENDIF
      ENDIF
      RETURN
100   FORMAT(' ','File transfer COMPLETED')
101   FORMAT(' ','File transfer FAILED')
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SSEND(ALIN)
C  
C     JL 4/18/84 17:30
C  
C     setting up remote line and directory file before calling SENDSW
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 ALIN(1),ISEND(5)
      INTEGER*2 MOREFILE(132),A1,Z1,STATUS,TEMP,I
      INTEGER*2 FLAG,B1,TPNAME(132),CH1,CH2,XREAD,XWRITE
      INTEGER*2 LOGTTY(132),TLINE(132),X,BELL,FINDLN
C  
      DATA ISEND /83,69,78,68,10002/
      MOREFILE(1)=BIGM
      MOREFILE(2)=BIGO
      MOREFILE(3)=BIGR
      MOREFILE(4)=BIGE
      MOREFILE(5)=BIGF
      MOREFILE(6)=BIGI
      MOREFILE(7)=LF
      MOREFILE(8)=EOS
C     logtty array is not being used
      LOGTTY(1)=BIGA
      LOGTTY(2)=BIGB
      LOGTTY(3)=BIGC
      LOGTTY(4)=BIGD
      LOGTTY(5)=BIGE
      LOGTTY(6)=BIGF
      LOGTTY(7)=LF
      LOGTTY(8)=EOS
C  
      BELL=7
      XREAD=0
      XWRITE=1
C  
      A1=1
      FLAG=FINDLN(ALIN,ISEND,A1,Z1)
      A1=Z1+1
      CALL SKIPBL(ALIN,A1)
      IF(ALIN(A1).EQ.LF)THEN
         WRITE (1)  'Proper format is "SEND FILENAME" or '
         WRITE (1) '"SEND @FILENAME"'
         RETURN
      ENDIF
C  
      IF(ALIN(A1).EQ.ATSIGN)THEN                    !is it a directory f
         A1=A1+1
         B1=1
         TPNAME(1)=LF
         TPNAME(2)=EOS
         CALL SCOPY(ALIN,A1,TPNAME,B1)
         CH1=AOPEN(TPNAME,XREAD)                    !open that directory
         IF(CH1.EQ.BAD)THEN                         !does it existed ?
             WRITE (1) 'Source of dirctory file not found--> '
             CALL PUTLIN(TPNAME,LOCALOUTFD)
             RETURN
         ENDIF
         CALL REMOVE(MOREFILE)                      !yes, remove temp fi
         CH2=AOPEN(MOREFILE,XWRITE)                 !open it for writing
         IF(CH2.EQ.BAD)THEN
            WRITE (1)  'unable to open temporary file--> '
            CALL PUTLIN(MOREFILE,LOCALOUTFD)
            CALL RATCLOSE(CH1)
            RETURN
         ENDIF
         DO WHILE(DGETLIN(TLINE,CH1).NE.EOF)         !copy content of dir
            CALL DPUTLIN(TLINE,CH2)                  !into temporary file
         END DO
         CALL RATCLOSE(CH1)                         !close directory cha
         CALL RATCLOSE(CH2)                         !close temporary fil
      ELSE
          B1=1                                      !it is not a directo
          CALL SCOPY(ALIN,A1,TPNAME,B1)
          CALL REMOVE(MOREFILE)                     !remove temporary fi
          CH1=AOPEN(MOREFILE,XWRITE)                !open it for writing
          IF(CH1.EQ.BAD)THEN
             WRITE (1) 'unable to open temporary file--> '
             CALL PUTLIN(MOREFILE,LOCALOUTFD)
          ENDIF
          CH2=AOPEN(TPNAME,XREAD)                   !does that single so
          IF(CH2.EQ.BAD)THEN                        !file exist ??
             WRITE (1) 'Source file does not existed--> '
             CALL PUTLIN(TPNAME,LOCALOUTFD)
             CALL RATCLOSE(CH1)
             RETURN
          ELSE
              CALL RATCLOSE(CH2)                    !yes it does
          ENDIF
          CALL DPUTLIN(TPNAME,CH1)                   !write the name of t
          CALL RATCLOSE(CH1)                        !single source file
      ENDIF                                         !the temp file and c
C                                                   !the temporary file
C  
      IF(HOSTON.EQ.YES)THEN                         !we are running in H
         CALL XDELAY(DELAY)
         CALL SETRAW(RMTINFD,LOGTTY)                !put TTY into RAW mo
         STATUS=SENDSW(X)                           !send the request fi
         CALL SETCOOK(RMTINFD,LOGTTY)               !put TTY into COOK m
      ELSE
          CALL SETRAW(RMTINFD,RMTTTY)               !put TTY into RAW mo
          CALL SETPAR(RMTOUTFD,RMTTTY)              !set user selected p
          CALL SETBAUD(RMTOUTFD,RMTTTY)             !set user selected b
          CALL SETPORT(RMTINFD,RMTTTY)              !set port id and con
          STATUS=SENDSW(X)                          !send the request fi
          CALL SETCOOK(RMTINFD,RMTTTY)              !put TTY into COOK m
          CALL TPUTCH(BELL,LOCALSLU)                !output a bell
          CALL TPUTCH(BELL,LOCALSLU)                !output a bell
          IF(STATUS.EQ.YES)THEN
             WRITE(1,100)
          ELSE
              WRITE(1,101)
          ENDIF
      ENDIF
      RETURN
100   FORMAT(' ','file transfer COMPLETED')
101   FORMAT(' ','file transfer FAILED')
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SSET(ALIN)
C  
C     JL 5/1/84 10:00
C  
C     parse and set various selectable parameters
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER*2 ALIN(1)
      INTEGER*2 A1,T1,T2,T3,T4,T5,T6,TV,CTOI
      INTEGER*2 FLAG1,FLAG2,FLAG3,FLAG4,FLAG5,FLAG6,FLAG7
      INTEGER*2 FLAG8,FLAG9,FLAG10,FLAG11,F1,F2,F3,F4,F5,F6,F7,F8
      INTEGER*2 F9,F10,F11,Z1,Z2,Z3,Z4,Z5,Z6,Z7,Z8,Z9,Z10,Z11
C  
      INTEGER*2   IBAUD(5),IDELAY(6),IPARITY(7),IODD(4)
      INTEGER*2   IEVEN(5),IMARK(5),ISPACE(6),INONE(5)
      INTEGER*2   IIBM(4),ION(3),IOFF(4),IESCAPE(7),ILINE(5)
      INTEGER*2   IPROMPT(7),IPACKET(7),ISOH(4),IEOL(4)
      INTEGER*2   IQUOTE(8),ISET(4)
C  
C     initialized various kerword character string
C  
      DATA IBAUD /66,65,85,68,10002/
      DATA IDELAY /68,69,76,65,89,10002/
      DATA IPARITY /80,65,82,73,84,89,10002/
      DATA IODD /79,68,68,10002/
      DATA IEVEN /69,86,69,78,10002/
      DATA IMARK /77,65,82,75,10002/
      DATA ISPACE /83,80,65,67,69,10002/
      DATA INONE /78,79,78,69,10002/
      DATA IIBM /73,66,77,10002/
      DATA ION /79,78,10002/
      DATA IOFF /79,70,70,10002/
      DATA IESCAPE /69,83,67,65,80,69,10002/
      DATA ILINE /76,73,78,69,10002/
      DATA IPROMPT /80,82,79,77,80,84,10002/
      DATA IPACKET /80,65,67,75,69,84,10002/
      DATA ISOH /83,79,72,10002/
      DATA IEOL /69,79,76,10002/
      DATA IQUOTE /77,89,81,85,79,84,69,10002/
C  
C     converts various keyword character string into integer array
C     and added an extra EOS to the end of the integer array
C  
      A1=1
      FLAG1=FINDLN(ALIN,ISET,A1,Z1)      !look for the keyword SET
      A1=A1+1
      CALL SKIPBL(ALIN,A1)               !skip any blanks any tabs
      TV=A1
      F1=TV
C  
      FLAG1=FINDLN(ALIN,IBAUD,F1,Z1)     !look for the keyword BAUD
      F2=TV
      FLAG2=FINDLN(ALIN,IDELAY,F2,Z2)    !look for the keyword DELAY
      F3=TV
      FLAG3=FINDLN(ALIN,IPARITY,F3,Z3)   !look for the keyword PARITY
      F4=TV
      FLAG4=FINDLN(ALIN,IIBM,F4,Z4)      !look for the keyword IBM
      F5=TV
      FLAG5=FINDLN(ALIN,IESCAPE,F5,Z5)   !look for the keyword ESCAPE
      F6=TV
      FLAG6=FINDLN(ALIN,ILINE,F6,Z6)     !look for the keyword LINE
      F7=TV
      FLAG7=FINDLN(ALIN,IPROMPT,F7,Z7)   !look for the keyword PROMPT
      F8=TV
      FLAG8=FINDLN(ALIN,IPACKET,F8,Z8)   !look for the keyword PACKET
      F9=TV
      FLAG9=FINDLN(ALIN,ISOH,F9,Z9)      !look for the keyword SOH
      FLAG10=NO
      F11=TV
      FLAG11=FINDLN(ALIN,IQUOTE,F11,Z11) !look for the keyword QUOTE
C  
      IF(FLAG1.EQ.YES)THEN               !set baud
         IF(SBAUD.EQ.YES)THEN
            IF(HOSTON.EQ.YES)THEN
               WRITE(1,100)
               WRITE(1,101)
               RETURN
            ENDIF
            F1=Z1+1
            CALL SKIPBL(ALIN,F1)         !skip any blanks or tabs
            X=CTOI(ALIN,F1)
            IF(X.EQ.300)THEN             !set speed to 300
               SPEED=300
            ELSE IF(X.EQ.1200)THEN       !set speed to 1200
                    SPEED=1200
            ELSE IF(X.EQ.2400)THEN       !set speed to 2400
                    SPEED=2400
            ELSE IF(X.EQ.4800)THEN       !set speed to 4800
                    SPEED=4800
            ELSE IF(X.EQ.9600)THEN       !set speed to 9600
                    SPEED=9600
            ELSE
                WRITE(1,102)
                RETURN
            ENDIF
         ELSE
             WRITE(1,103)
         ENDIF
      ELSE IF(FLAG2.EQ.YES)THEN          !set delay
              IF(HOSTON.EQ.NO)THEN
                 WRITE(1,104)
                 RETURN
              ENDIF
              F2=Z2+1
              CALL SKIPBL(ALIN,F2)
              X=CTOI(ALIN,F2)
              IF(X.LT.0)THEN
                 WRITE(1,105)
                 RETURN
              ELSE IF(X.GT.30)THEN
                   WRITE(1,106)
                   WRITE(1,107)
                      DELAY=30
                      RETURN
              ELSE
                  DELAY=X
                  RETURN
              ENDIF
      ELSE IF(FLAG3.EQ.YES)THEN          !set parity
              IF(SPARITY.EQ.YES)THEN
                 IF(HOSTON.EQ.YES)THEN
                    WRITE(1,108)
                    WRITE(1,109)
                    RETURN
                 ENDIF
                 F3=Z3+1
                 CALL SKIPBL(ALIN,F3)    !skip any blanks or tabs
                 TV=F3
                 T1=FINDLN(ALIN,IEVEN,TV,T6) !look for keyword EVEN
                 TV=F3
                 T2=FINDLN(ALIN,IODD,TV,T6)  !look for the keyword ODD
                 TV=F3
                 T3=FINDLN(ALIN,ISPACE,TV,T6)!look for the keyword SPACE
                 TV=F3
                 T4=FINDLN(ALIN,IMARK,TV,T6) !look for the keyword MARK
                 TV=F3
                 T5=FINDLN(ALIN,INONE,TV,T6) !look for the keyword NONE
                 IF(T1.EQ.YES)THEN
                    PARITY=1                 !set parity to EVEN
                 ELSE IF(T2.EQ.YES)THEN
                         PARITY=2            !set parity to ODD
                 ELSE IF(T3.EQ.YES)THEN
                      WRITE(1,110)
                         RETURN
                 ELSE IF(T4.EQ.YES)THEN
                         WRITE(1,111)
                         RETURN
                 ELSE IF(T5.EQ.YES)THEN
                         PARITY=5            !set parity to NONE
                 ELSE
                     WRITE(1,112)
                     RETURN
                 ENDIF
             ELSE
                 WRITE(1,113)
                 RETURN
             ENDIF
      ELSE IF(FLAG4.EQ.YES)THEN              !set IBM
              IF(HOSTON.EQ.YES)THEN
                 WRITE(1,114)
                 WRITE(1,115)
                 RETURN
              ENDIF
              F4=Z4+1
              CALL SKIPBL(ALIN,F4)           !skip any blanks or tabs
              TV=F4
              TV1=FINDLN(ALIN,ION,TV,T6)     !look for keyword ON
              TV=F4
              TV2=FINDLN(ALIN,IOFF,TV,T6)    !look for keyword OFF
              IF(TV1.EQ.YES)THEN
                 IBMON=YES                   !set IBM flag ON
              ELSE IF(TV2.EQ.YES)THEN
                      IBMON=NO               !set IBM flag OFF
              ELSE
                  WRITE(1,116)
                  RETURN
              ENDIF
      ELSE IF(FLAG5.EQ.YES)THEN              !set escape
              IF(HOSTON.EQ.YES)THEN
                 WRITE(1,117)
                 WRITE(1,118)
                 RETURN
              ENDIF
              F5=Z5+1
              CALL SKIPBL(ALIN,F5)          !skip any blanks or tabs
              X=CTOI(ALIN,F5)
              IF((X.GT.0).AND.(X.LT.32))THEN
                  ESCHAR=X
              ELSE
                  WRITE(1,119)
                  RETURN
              ENDIF
      ELSE IF(FLAG6.EQ.YES)THEN             !set remote line
              IF(HOSTON.EQ.YES)THEN
                 WRITE(1,120)
                 RETURN
              ENDIF
              IF(SPORT.EQ.YES)THEN          !is set line supported ??
                 F6=Z6+1
                 CALL SKIPBL(ALIN,F6)       !skip any blanks or tab
                 A1=1
                 CALL SCOPY(ALIN,F6,RMTTTY,A1)  !store the remote filena
                 RETURN
              ELSE
                  WRITE(1,121)
                  WRITE(1,122)
                  RETURN
              ENDIF
      ELSE IF(FLAG7.EQ.YES)THEN             !set IBM prompt
              IF(HOSTON.EQ.YES)THEN
                 WRITE(1,123)
                 WRITE(1,124)
                 RETURN
              ENDIF
              F7=Z7+1
              CALL SKIPBL(ALIN,F7)         !skip any blanks or tabs
              X=CTOI(ALIN,F7)
              IF((X.EQ.EOL).OR.(X.EQ.SOH))THEN
                  WRITE(1,125)
                  RETURN
              ELSE
                  IF((X.GT.0).AND.(X.LT.32))PROMPT=X
              ENDIF
      ELSE IF(FLAG8.EQ.YES)THEN            !set packet size
              F8=Z8+1
              CALL SKIPBL(ALIN,F8)
              X=CTOI(ALIN,F8)
              IF((X.GT.30).AND.(X.LT.95))THEN
                  PAKSIZ=X
                  RETURN
              ELSE
                  WRITE(1,126)
                  RETURN
              ENDIF
      ELSE IF(FLAG9.EQ.YES)THEN            !set SOH
              F9=Z9+1
              CALL SKIPBL(ALIN,F9)         !skip any blanks or tabs
              X=CTOI(ALIN,F9)
              IF(HOSTON.EQ.YES)THEN
                 IF(X.EQ.EOL)THEN
                    WRITE(1,127)
                    RETURN
                 ELSE
                     IF((X.GT.0).AND.(X.LT.32))THEN
                         SOH=X
                         RETURN
                     ELSE
                         WRITE(1,128)
                         RETURN
                     ENDIF
                 ENDIF
              ELSE
                  IF((X.EQ.EOL).OR.(X.EQ.PROMPT))THEN
                      WRITE(1,129)
                      WRITE(1,130)
                      RETURN
                  ELSE
                      IF((X.GT.0).AND.(X.LT.32))THEN
                          SOH=X
                          RETURN
                      ELSE
                          WRITE(1,131)
                          WRITE(1,132)
                          RETURN
                      ENDIF
                  ENDIF
              ENDIF
      ELSE IF(FLAG10.EQ.YES)THEN         !set EOL
              F10=Z10+1
              CALL SKIPBL(ALIN,F10)
              X=CTOI(ALIN,F10)
              IF(HOSTON.EQ.YES)THEN
                 IF(X.EQ.SOH)THEN
                    WRITE(1,133)
                    RETURN
                 ELSE
                     IF((X.GT.0).AND.(X.LT.32))THEN
                         MYEOL=X
                         RETURN
                     ELSE
                         WRITE(1,134)
                         WRITE(1,135)
                         RETURN
                     ENDIF
                 ENDIF
              ELSE
                  IF((X.EQ.SOH).OR.(X.EQ.PROMPT))THEN
                      WRITE(1,136)
                      WRITE(1,137)
                      RETURN
                  ELSE
                      IF((X.GT.0).AND.(X.LT.32))THEN
                          MYEOL=X
                          RETURN
                      ELSE
                          WRITE(1,138)
                          WRITE(1,139)
                          RETURN
                      ENDIF
                  ENDIF
               ENDIF
      ELSE IF(FLAG11.EQ.YES)THEN         !set myquote
              F11=Z11+1
              CALL SKIPBL(ALIN,F11)
              X=CTOI(ALIN,F11)
              IF((X.GT.32).AND.(X.LT.127))THEN
                  MYQUOTE=X
                  RETURN
              ELSE
                  WRITE(1,140)
                  WRITE(1,141)
                  RETURN
              ENDIF
      ELSE
          WRITE(1,142)
          RETURN
      ENDIF
      RETURN
100   FORMAT(' ','Baud rate setting not supported')
101   FORMAT(' ','in Remote Host mode')
102   FORMAT(' ','Invalid or Unsupported baud rate selected')
103   FORMAT(' ','This system does not supported baud selection')
104   FORMAT(' ','Delay setting not valid in Local Host mode')
105   FORMAT(' ','Invalid delay setting')
106   FORMAT(' ','Delay setting too long')
107   FORMAT(' ','defaulted to 30 seconds')
108   FORMAT(' ','Parity setting not supported')
109   FORMAT(' ','in Remote Host mode')
110   FORMAT(' ','SPACE parity not supported in HP1000')
111   FORMAT(' ','MARK parity not supported in HP1000')
112   FORMAT(' ','Parity selected not valid')
113   FORMAT(' ','Parity setting not supported in this system')
114   FORMAT(' ','SET IBM ON/OFF not supported in')
115   FORMAT(' ','Remote Host mode')
116   FORMAT(' ','Invalid SET IBM mode selected')
117   FORMAT(' ','Escape setting not valid in')
118   FORMAT(' ','Remote Host mode')
119   FORMAT(' ','Escape character must be between 0 & 32')
120   FORMAT(' ','SET LINE not valid in Remote Host mode')
121   FORMAT(' ','SET remote line is not supported')
122   FORMAT(' ','in Remote Host mode')
123   FORMAT(' ','SET IBM PROMPT not valid')
124   FORMAT(' ','In Remote Host mode')
125   FORMAT(' ','Invalid; in conflict with EOL or SOH')
126   FORMAT(' ','Invalid Packet size specifiecd')
127   FORMAT(' ','Invalid; in conflict with EOL')
128   FORMAT(' ','Invalid; SOH must be between 0 & 32')
129   FORMAT(' ','Invalid; in conflict with EOL')
130   FORMAT(' ','or IBM prompt')
131   FORMAT(' ','Invalid; SOH must be between')
132   FORMAT(' ','0 & 32')
133   FORMAT(' ','Invalid; in conflict with SOH')
134   FORMAT(' ','Invalid; EOL must be between')
135   FORMAT(' ','0 & 32')
136   FORMAT(' ','Invalid; EOL in conflict with')
137   FORMAT(' ','SOH or IBM prompt')
138   FORMAT(' ','Invalid; EOL must be between')
139   FORMAT(' ','0 & 32')
140   FORMAT(' ','QUOTE character must be between')
141   FORMAT(' ','32 & 127')
142   FORMAT(' ','Invalid SET parameter(s) detected')
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SSTATUS
C  
C     JL 4/19/84 9:03
C  
C     output the status and values of variables
C  
$INCLUDE KERCOM
$INCLUDE KERDEF
C  
      INTEGER I
C  
      IF(HOSTON.EQ.YES)THEN          !we are running in remote host mode
         WRITE(1,107)
         WRITE(1,104)DELAY
         WRITE(1,103)MYEOL
         WRITE(1,100)PAKSIZ
         WRITE(1,102)MYQUOTE
         WRITE(1,101)SOH
         IF(STATE.EQ.BIGC)THEN
            WRITE(1,108)
         ELSE
             WRITE(1,109)
         ENDIF
       ELSE
           WRITE(1,110)
           WRITE(1,106)SPEED
           WRITE(1,103)MYEOL
           WRITE(1,105)ESCHAR
           IF(IBMON.EQ.YES)THEN
              WRITE(1,117)
              WRITE(1,119)PROMPT
           ELSE
              WRITE(1,118)
           ENDIF
           WRITE(1,100)PAKSIZ
           IF(PARITY.EQ.1)THEN
              WRITE(1,111)
           ELSE IF(PARITY.EQ.2)THEN
                   WRITE(1,112)
           ELSE IF(PARITY.EQ.3)THEN
                   WRITE(1,113)
           ELSE IF(PARITY.EQ.4)THEN
                   WRITE(1,114)
           ELSE
               WRITE(1,115)
           ENDIF
           WRITE(1,102)MYQUOTE
           WRITE(1,101)SOH
           WRITE(1,116)
           IF(STATE.EQ.BIGC)THEN
              WRITE(1,108)
           ELSE
               WRITE(1,109)
           ENDIF
      ENDIF
100   FORMAT(' ','PACKET size = ',I4)
101   FORMAT(' ','SOH = ',I4)
102   FORMAT(' ','MYQUOTE = ',I4)
103   FORMAT(' ','MYEOL = ',I4)
104   FORMAT(' ','DELAY in seconds = ',I4)
105   FORMAT(' ','ESCAPE Char = ',I4)
106   format(' ','BAUD Rate = ',I4)
107   FORMAT(' ','Remote Host KERMIT mode in effect')
108   FORMAT(' ','File transfer state = C')
109   FORMAT(' ','File transfer state = A')
110   FORMAT(' ','Local KERMIT mode in effect')
111   FORMAT(' ','PARITY = EVEN')
112   FORMAT(' ','PARITY = ODD')
113   FORMAT(' ','PARITY = SPACE')
114   FORMAT(' ','PARITY = MARK')
115   FORMAT(' ','PARITY = NONE')
116   FORMAT(' ','Remote TTY line used is ??')
117   FORMAT(' ','IBM flag = ON')
118   FORMAT(' ','IBM flag = OFF')
119   FORMAT(' ','IBM PROMPT = ',I4)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION TGETCH(XCHAR,CH)
C  
C     JL 4/25/84 14:20
C  
C     get a CHAR from the TTY without echoing it
C  
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 XCHAR,CH
      INTEGER*2 ICODE,ICNWD,ILEN,IBUF,TV,IA,IB
      COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
     +             VXONXOFF,VREST
C  
$INCLUDE KERDEF
      ICODE=1+140000B
      ICNWD=CH+VRAWCOOK
      ILEN=-1
      CALL EXEC(ICODE,ICNWD,IBUF,ILEN,*100) !read a single byte
      TV=IAND(IBUF,77400B)                 !mask out the parity bit
      XCHAR=ISHFT(TV,-8)                    !shift it right by 8 bits
      TGETCH=OK
      RETURN
100   CONTINUE
      WRITE(1) 'ERROR IN TGETCH FUNCTION'
      CALL ABREG(IA,IB)
      WRITE(1,101)IA,IB
      TGETCH=OK
101   FORMAT(' ','Value of IA & IB are ',2I4)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION TOCHAR(CH)
C  
C     JL 4/19/84 9:05
C  
      INTEGER*2 CH
C  
$INCLUDE KERDEF
      TOCHAR=CH+BLANK
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE TPUTCH(XCHAR,CH)
C  
C     JL 4/25/84 14:25
C  
C     output a char to the TTY line
C  
      INTEGER*2 XCHAR,CH
      INTEGER*2 ICODE,ICNWD,ILEN,IBUF,TV,IA,IB
C  
$INCLUDE KERDEF
      ICODE=2+140000B
      ICNWD=CH+2000B
      ILEN=-1
      IBUF=ISHFT(XCHAR,8)                   !shift byte left by 8 bits
      CALL EXEC(ICODE,ICNWD,IBUF,ILEN,*100) !output a single byte
      RETURN
100   CONTINUE
      WRITE(1) 'ERROR IN TPUTCH SUBROUTINE'
      CALL ABREG(IA,IB)
      WRITE(1,101)IA,IB
101   FORMAT(' ','Value of IA & IB are ',2I4)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION UNCHAR(CH)
C  
C     JL 4/19/84 9:05
C  
      INTEGER*2 CH
C  
$INCLUDE KERDEF
      UNCHAR=CH-BLANK
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE UPPER(ALIN,BLIN)
C  
C     JL 4/19/84 9:05
C  
C     convert lower (ALIN) to upper case (BLIN)
C  
C  
      INTEGER*2 ALIN(1),BLIN(1),A1
C  
$INCLUDE KERDEF
      A1=1
C  
      DO WHILE(ALIN(A1).NE.EOS)
         IF((ALIN(A1).GT.96).AND.(ALIN(A1).LT.123))THEN
             BLIN(A1)=ALIN(A1)-32
         ELSE
             BLIN(A1)=ALIN(A1)
         ENDIF
         A1=A1+1
      END DO
C  
      BLIN(A1)=EOS
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE VERIFY(TFILE)
C  
C     JL 4/19/84 9:05
C  
C     verify that the filename is valid in this system, if not make it s
C  
C  
      INTEGER*2 INFILE(132),OUTFILE(132),TFILE(1)
      INTEGER*2 AONE,BONE,TEMP
C  
$INCLUDE KERDEF
      AONE=1
      BONE=1
      TEMP=1
      CALL UPPER(TFILE,INFILE)
      DO I=1,132
         TFILE(I)=BLANK
         OUTFILE(I)=BLANK
      END DO
C  
      DO WHILE((INFILE(TEMP).NE.LF).AND.(INFILE(TEMP).NE.EOS))
         IF((INFILE(TEMP).GT.64).AND.(INFILE(TEMP).LT.91))THEN
             OUTFILE(TEMP)=INFILE(TEMP)
         ELSE IF((INFILE(TEMP).GT.47).AND.(INFILE(TEMP).LT.58))THEN
              OUTFILE(TEMP)=INFILE(TEMP)
         ELSE
              OUTFILE(TEMP)=BIGA       !period
         ENDIF
         TEMP=TEMP+1
      END DO
C  
C     HP1000 allow maximum of 6 characters for filename
      TEMP=7
      IF((OUTFILE(1).GT.47).AND.(OUTFILE(1).LT.58))THEN
          OUTFILE(1)=BIGA
      ENDIF
      OUTFILE(TEMP)=EOS
      CALL SCOPY(OUTFILE,AONE,TFILE,BONE)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE XDELAY(X)
C  
C     JL 4/25/84 13:40
C  
C     delay the calling program for x seconds
C  
      INTEGER*2 INAME(3),ICODE,IRESL,IMULT,IOFST,X
C  
      ICODE=12
      INAME(1)=0
      INAME(2)=0
      INAME(3)=0
      IRESL=2
      IMULT=0
      IOFST=-X
      IF(X.EQ.0)IOFST=-1
C  
      CALL EXEC(ICODE,INAME,IRESL,IMULT,IOFST)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
