CCCCCCCCCCCCCCCCCCCCCC  AOPEN.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
C     OPEN A FILE FOR READ/WRITE
      INTEGER FUNCTION AOPEN(FNAME,MODE)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 FNAME(1),MODE
      INTEGER*2 CR,LF,EOS,NULL,AREAD,AWRITE,AREADWRITE,APPEND,COUNT
      INTEGER*2 CHAN
      INTEGER*2 TEMP
      INTEGER*2 ERR,ACOUNT
      INTEGER*4 BUFLEN,RETLEN,STATUS
      CHARACTER INCHAR(132)
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/PGM.INS.FTN'
%INCLUDE '/SYS/INS/NAME.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
      AREAD=0
      AWRITE=1
C     READWRITE IS NOT SUPPORTED
      AREADWRITE=2
      APPEND=3
      ERR=10001
      CR=13
      LF=10
      NULL=0
      EOS=10002
C     CONVERT INTO CHARACTER STRING
      COUNT=1
1     CONTINUE
      IF((FNAME(COUNT).EQ.CR).OR.(FNAME(COUNT).EQ.LF)
     +    .OR.(FNAME(COUNT).EQ.EOS).OR.(FNAME(COUNT).EQ.NULL))GOTO 100
      INCHAR(COUNT)=CHAR(FNAME(COUNT))
      BUFLEN=COUNT
      COUNT=COUNT+1
      GOTO 1
100   CONTINUE
      IF(MODE.EQ.AREAD)GOTO 200
C     CREATE THE FILE AND IGNOR ERROR MESSAGE
      IF(MODE.EQ.AWRITE)GOTO 300
      IF(MODE.EQ.APPEND)GOTO 300
      IF(MODE.EQ.AREADWRITE)GOTO 300
200   CONTINUE
      ACOUNT=BUFLEN
      CALL STREAM_$OPEN(INCHAR,ACOUNT,STREAM_$READ,
     +                  STREAM_$NO_CONC_WRITE,CHAN,STATUS)
      IF(STATUS.EQ.STATUS_$OK)GOTO 250
C     ERROR IN OPEN, PROBABLY FILE DOES NOT EXIST
      AOPEN=ERR
      CALL PUTLIN(FNAME,LOCALOUTFD)
      GOTO 800
250   CONTINUE
      AOPEN=CHAN
      GOTO 800
300   CONTINUE
      ACOUNT=BUFLEN
C     FIRST CREATE THE FILENAME
      CALL STREAM_$CREATE(INCHAR,ACOUNT,STREAM_$APPEND,
     +                    STREAM_$NO_CONC_WRITE,CHAN,STATUS)
      IF(STATUS.NE.STATUS_$OK)GOTO 700
      AOPEN=CHAN
      GOTO 800
700   CONTINUE
      AOPEN=ERR
      CALL PUTLIN(FNAME,LOCALOUTFD)
800   CONTINUE
      END
CCCCCCCCCCCCCCCCCCCCCC BINDKERMIT    CCCCCCCCCCCCCCCCCCCCCCCCCC
BIND -B RUNKERMIT - <<!
aopen.bin
bufemp.bin
bufill.bin
cant.bin
connect.bin
ctl.bin
dgetch.bin
findln.bin
getlin.bin
ibmgetlin.bin
kermit.bin
kgetch.bin
kgetlin.bin
kputch.bin
putlin.bin
ratclose.bin
ratexit.bin
rdata.bin
recsw.bin
remove.bin
rfile.bin
rinit.bin
rpack.bin
rpar.bin
sbreak.bin
scopy.bin
sdata.bin
sendsw.bin
seof.bin
sfile.bin
sinit.bin
spack.bin
spar.bin
tochar.bin
unchar.bin
upper.bin
verify.bin
!
CCCCCCCCCCCCCCCCCCCCCC   BUFEMP.FTN CCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE BUFEMP(BUFFER,LEN)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 BUFFER(1)
      INTEGER*2 CH,LEN,CTL
      INTEGER*2 I,T
      CH=FD
      I=1
23000 IF(.NOT.(I.LT.LEN+1))GOTO 23002
      T=BUFFER(I)
      IF(.NOT.(T.EQ.35 ))GOTO 23003
      I=I+1
      T=BUFFER(I)
      IF(.NOT.(T.NE.35 ))GOTO 23005
      T=CTL(T)
23005 CONTINUE
23003 CONTINUE
      IF(.NOT.(T.NE.13))GOTO 23007
      CALL KPUTCH(T,CH)
23007 CONTINUE
23001 I=I+1
      GOTO 23000
23002 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC  BUFILL.FTN   CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION BUFILL(BUFFER)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 I,CTL,T,DGETCH,BUFFER(1),CH
      INTEGER*2 VCR
      I=1
      VCR=13
      CH=FD
23000 IF(.NOT.(DGETCH(T,CH).GT.0))GOTO 23001
      IF(.NOT.((T.LT.32 ).OR.(T.EQ.127 ).OR.(T.EQ.QUOTE)))GOTO 23002
      IF(.NOT.(T.EQ.10))GOTO 23004
      BUFFER(I)=QUOTE
C     PRINT *,'I GOT A NEWLINE'
      I=I+1
      BUFFER(I)=CTL(VCR)
      I=I+1
23004 CONTINUE
      BUFFER(I)=QUOTE
      I=I+1
      IF(.NOT.(T.NE.QUOTE))GOTO 23006
      T=CTL(T)
23006 CONTINUE
23002 CONTINUE
      BUFFER(I)=T
      I=I+1
      IF(.NOT.(I.GT.SPSIZ-8))GOTO 23008
      BUFILL=I-1
      RETURN
23008 CONTINUE
      GOTO 23000
23001 CONTINUE
      IF(.NOT.(I.EQ.1))GOTO 23010
      BUFILL=10003
      RETURN
23010 CONTINUE
      BUFILL=I-1
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC CANT.FTN      CCCCCCCCCCCCCCCCCCCCCCCCCC
C     UNABLE TO OPEN A FILE
      SUBROUTINE CANT(FNAME)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 FNAME(1)
      INTEGER*2 COUNT,EOS,CR,LF,NULL,TEMP
      INTEGER*4 STATUS,BUFLEN,SEEK_KEY(3)
      CHARACTER INCHAR(132)
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
      EOS=10002
      CR=13
      LF=10
      NULL=0
      COUNT=1
      PRINT *, 'UNABLE TO OPEN THIS FILE'
1     CONTINUE
      IF((FNAME(COUNT).EQ.CR).OR.(FNAME(COUNT).EQ.LF)
     +    .OR.(FNAME(COUNT).EQ.EOS).OR.(FNAME(COUNT).EQ.NULL))GOTO 100
      INCHAR(COUNT)=CHAR(FNAME(COUNT))
      COUNT=COUNT+1
      GOTO 1
100   CONTINUE
      INCHAR(COUNT)=CHAR(LF)
      BUFLEN=COUNT
      CALL STREAM_$PUT_CHR(STREAM_$STDIN,IADDR(INCHAR),
     +                     BUFLEN,SEEK_KEY,STATUS)
      STOP
      END
CCCCCCCCCCCCCCCCCCCCCC CONNECT.FTN   CCCCCCCCCCCCCCCCCCCCCCCCCC
C     CONNECT, PUT THE TERMINAL IN A A CHAT WITH THE REMOTE HOST
      SUBROUTINE CONNECT(LOCALIN,LOCALOUT,RMTIN,RMTOUT)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY,FD,RMTINFD,
     +             RMTOUTFD,STATE,PADCHAR,EOL,ESCHAR,QUOTE,
     +             FILNAM(132),RECPKT(94),PACKET(94),SIZE,
     +             MOREFD,IBM,HOST,LOCALINFD,LOCALOUTFD,SPEED,
      INTEGER*2 LOCALIN,LOCALOUT,RMTIN,RMTOUT
      INTEGER*2 TEMP
      LOGICAL ONE,ZERO
      INTEGER*4 PTRI,PTRO
      INTEGER*4 BUFLEN,RETLEN,STATUS,SEEK_KEY(3)
      CHARACTER*1 INCHAR(132),OUTCHAR(132)
      POINTER /PTRO/OUTCHAR
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/PGM.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
%INCLUDE '/SYS/INS/SIO.INS.FTN'
%INCLUDE '/SYS/INS/PAD.INS.FTN'
      BUFLEN=132
      ONE=.TRUE.
      ZERO=.FALSE.
      CALL PAD_$RAW(LOCALIN,STATUS)
      CALL SIO_$CONTROL(RMTIN,SIO_$RAW,ONE,STATUS)
      PRINT *, 'TO EXIT FROM CHAT MODE, ENTER CNTR-]'
C     DO FOREVER UNTIL ONE SEE THE ~
1     CONTINUE
C     READ FROM THE LOCAL KEYBOARD
      RETLEN=0
      CALL STREAM_$GET_CONDITIONAL(LOCALIN,IADDR(INCHAR),
     +    BUFLEN,PTRO,RETLEN,SEEK_KEY,STATUS)
      IF(STATUS.NE.STATUS_$OK)CALL ERROR_$PRINT(STATUS)
C     IS THERE ANY DATA THERE ?
      IF(RETLEN.EQ.0)GOTO 50
C     SOMETHING IS THERE, IS THIS THE CNTR-] CHARACTER
      TEMP=ICHAR(OUTCHAR(1))
      IF(TEMP.EQ.29)GOTO 100
C     SOMETHING IS THERE FOR OUTPUTING TO REMOTE HOST
      IF(IBM.NE.0)CALL STREAM_$PUT_CHR(LOCALOUT,IADDR(OUTCHAR),RETLEN,
     +                                 SEEK_KEY,STATUS)
      CALL STREAM_$PUT_CHR(RMTOUT,IADDR(OUTCHAR),RETLEN,
     +                     SEEK_KEY,STATUS)
      IF(STATUS.NE.STATUS_$OK)CALL ERROR_$PRINT(STATUS)
50    CONTINUE
C     CHECK TO SEE IF THERE IS ANY DATA FROM THE REMOTE HOST
      RETLEN=0
      CALL STREAM_$GET_CONDITIONAL(RMTIN,IADDR(INCHAR),
     +       BUFLEN,PRTO,RETLEN,SEEK_KEY,STATUS)
      IF(STATUS.NE.STATUS_$OK)CALL ERROR_$PRINT(STATUS)
      IF(RETLEN.EQ.0)GOTO 1
C     WRITE THE ONE BYTE TO THE LOCAL TERMINAL
c
c     strip parity
c
      do 55 i = 1,retlen
        j = ichar(inchar(i))
        j = and(j,16#007F)
        inchar(i) = char(j)
55    continue

      CALL STREAM_$PUT_CHR(LOCALOUT,PRTO,RETLEN,
     +                     SEEK_KEY,STATUS)
      IF(STATUS.NE.STATUS_$OK)CALL ERROR_$PRINT(STATUS)
      GOTO 1
100   CONTINUE
      CALL PAD_$COOKED(LOCALIN,STATUS)
      CALL SIO_$CONTROL(RMTIN,SIO_$RAW,ZERO,STATUS)
      PRINT *, 'RETURNING TO KERMIT-APOLLO'
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC CTL.FTN       CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION CTL(CH)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 CH
      CTL=XOR(CH,8#100)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC DGETCH.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
C     GETCH A CHARACTER FROM A DISK FILE ONLY, NO TIME-OUT READ
      INTEGER FUNCTION DGETCH(T,CHAN)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 T,CHAN,X,IER,TEMP
      INTEGER*2 I2_STATUS(2)
      INTEGER*4 STATUS,BUFLEN,SEEK_KEY(3),RETLEN
      INTEGER*4 PTRO
      CHARACTER*1 INCHAR,OUTCHAR
      EQUIVALENCE (STATUS,I2_STATUS)
      POINTER /PTRO/OUTCHAR
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
      BUFLEN=1
C     PRINT *,'INSIDE THE DGETCH ROUTINE'
      CALL STREAM_$GET_BUF(CHAN,IADDR(INCHAR),BUFLEN,
     +          PTRO,RETLEN,SEEK_KEY,STATUS)
C     PRINT *,'JUST ISSUE A READ BYTE'
C     PRINT *,'JUST ISSUE THE CHECK STATUS'
      IF(I2_STATUS(2).EQ.STREAM_$END_OF_FILE)GOTO 100
C     PRINT *,'JUST CHECK FOR EOF'
      T=ICHAR(OUTCHAR)
      T=AND(T,16#7F)
C     print *, 'the value of dgetch is ',t
C     PRINT *,'THE VALUE OF OUTCHAR IS ',OUTCHAR
      DGETCH=1
C     PRINT *,'RETURN FROM DGETCH WITH ONE BYTE'
      RETURN
100   CONTINUE
      DGETCH=0
C     PRINT *,'RETURN FROM DGETCH WITH EOF'
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC FINDLN.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION FINDLN(LIN,APAT,A1,Z1)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 LIN(132)
      INTEGER*2 APAT(128)
      STATUS=-2
      T1=A1
23000 IF(.NOT.(STATUS.EQ.-2))GOTO 23001
23002 IF(.NOT.((LIN(T1).NE.APAT(1).AND.(LIN(T1)).NE.10002)))GOTO 23003
      T1=T1+1
      GOTO 23002
23003 CONTINUE
      IF(.NOT.(LIN(T1).EQ.10002))GOTO 23004
      STATUS=0
      GOTO 23005
23004 CONTINUE
      A1=T1
      T2=1
      T3=T1
      FLAG=0
23006 IF(.NOT.((FLAG.EQ.0).AND.(APAT(T2).NE.10002)))GOTO 23007
      IF(.NOT.(APAT(T2).EQ.LIN(T1)))GOTO 23008
      T1=T1+1
      T2=T2+1
      GOTO 23009
23008 CONTINUE
      FLAG=1
23009 CONTINUE
      GOTO 23006
23007 CONTINUE
      IF(.NOT.(APAT(T2).EQ.10002))GOTO 23010
      Z1=T1-1
      STATUS=1
      GOTO 23011
23010 CONTINUE
      T1=T3+1
23011 CONTINUE
23005 CONTINUE
      GOTO 23000
23001 CONTINUE
      FINDLN=STATUS
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC   GETLIN.FTN  CCCCCCCCCCCCCCCCCCCCCCCCCC
C     GET A LINE FROM THE LOCAL KEYBOARD OR DISK
C
      INTEGER FUNCTION GETLIN(ABUFF,CHAN)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 ABUFF(1),CHAN,T1,T2,T3,T4,EOF,EOS
      INTEGER*2 I2_STATUS(2)
      INTEGER*4 BUFLEN,RETLEN,STATUS,SEEK_KEY(3)
      INTEGER*4 PTRO
      CHARACTER INCHAR(132), OUTCHAR(132)
      EQUIVALENCE (STATUS,I2_STATUS)
      POINTER /PTRO/OUTCHAR
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
C     READ ME A LINE
      BUFLEN=132
      EOS=10002
      EOF=10003
      CALL STREAM_$GET_REC(CHAN,IADDR(INCHAR),BUFLEN,PTRO,RETLEN,
     +                             SEEK_KEY,STATUS)
      IF((I2_STATUS(2)).EQ.STREAM_$END_OF_FILE)GOTO 800
C     CONVERT IT AND PUT INTO BUFFER
      COUNT=1
      DO 1 I=1,RETLEN
      T4=ICHAR(OUTCHAR(I))
C     T1=AND(T4,16#7F00)
C     T2=RSHFT(T1,8)
      T3=COUNT
      COUNT=COUNT+1
      ABUFF(T3)=T4
1     CONTINUE
C     WE HAVE DETECTED AN CR OR LF
      ABUFF(COUNT)=EOS
      GETLIN=0
      RETURN
800   CONTINUE
      GETLIN=EOF
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC HELP_KERMIT   CCCCCCCCCCCCCCCCCCCCCCCCCC
 CONNECT          - Enters into the 'CHAT' mode, whatever you typed on the
                  - local keyboard is transmitted to the remote host, and
                  - information from the remote host are transmitted to the
                  - local terminal.  'CHAT' mode is used in establishing
                  - login sessions and invoking remote KERMIT program.
                  - CNTR ] will cause exit from 'CHAT' mode.

 EXIT             - EXIT from this KERMIT program and returns to the AEGIS
                  - command level.

 HELP             - Displays the content of this help file.

 QUIT             - QUIT from this KERMIT program and returns to the AEGIS
                  - command level.

 RECEIVE          - Enters the 'RECEIVE' state of file transfer mode,
                  - program waits for in-coming packet with no time-out
                  - detection capability provided.

 SEND             - Enters the 'SEND' state of file transfer mode, programs
                  - prompts for either a filename or a directory
                  - of filenames (i.e. @directory) to be transmitted.

 SET IBM OFF      - In 'CHAT' mode, expects remote system to echo back
                  - transmitted characters.  In file transfer mode, does
                  - not wait for the detection of DC1 before sending out
                  - the next packet.

 SET IBM ON       - In 'CHAT' mode, performs local echoing of transmitted
                  - characters.  In file transfer mode, wait for the
                  - detection of DC1 or CMS prompt from CMS before
                  - sending out the next packet.

 STATUS           - Displays the current values of various setting.

CCCCCCCCCCCCCCCCCCCCCC IBMGETLIN.FTN  CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION IBMGETLIN(BUFFER,CH)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /LABNET/ XSOH
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 BUFFER(132)
      INTEGER*2 CH,IBELL,ASTATUS,COUNT,IBYTE,T,GETSOH
      INTEGER*4 PTRO
      INTEGER*4 BUFLEN,RETLEN,STATUS,SEEK_KEY(3)
      CHARACTER*1 INCHAR,OUTCHAR
      POINTER /PTRO/OUTCHAR
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
C     IN A COLOR NODE, DC1 IS FILTER OUT, LOOK FOR THE BELL INSTEAD
      BUFLEN=1
      IBELL=7
      ASTATUS=1
C     DON'T LOOK FOR THE SOH FIRST, LET THE NEXT LOOP DO IT
      GETSOH=1
      COUNT=1
23000 IF(.NOT.(ASTATUS.EQ.1))GOTO 23001
23002 IF(.NOT.(GETSOH.EQ.0))GOTO 23003
      CALL STREAM_$GET_BUF(CH,IADDR(INCHAR),BUFLEN,PTRO,
     +                             RETLEN,SEEK_KEY,STATUS)
C     T=AND(OUTCHAR,16#7F00)
C     T=RSHFT(T,8)
      T=ICHAR(OUTCHAR)
C     STRIP OFF THE PARITY BIT
      T=AND(T,16#7F)
C     PRINT *,'THE VALUE OF T IS ',T
      IF(.NOT.(T.EQ.XSOH ))GOTO 23004
      GETSOH=1
      BUFFER(COUNT)=T
      COUNT=COUNT+1
23004 CONTINUE
      GOTO 23002
23003 CONTINUE
      CALL STREAM_$GET_BUF(CH,IADDR(INCHAR),BUFLEN,PTRO,
     +                             RETLEN,SEEK_KEY,STATUS)
C     T=AND(OUTCHAR,16#7F00)
C     T=RSHFT(T,8)
      T=ICHAR(OUTCHAR)
C     STRIP OFF THE PARITY BIT
      T=AND(T,16#7F)
C     PRINT *,'THE VALUE OF TT IS ',T
      IF(.NOT.(T.EQ.IBELL))GOTO 23006
      ASTATUS=0
      GOTO 23007
23006 CONTINUE
      BUFFER(COUNT)=T
      COUNT=COUNT+1
23007 CONTINUE
      GOTO 23000
23001 CONTINUE
      BUFFER(COUNT)=10002
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC KERMIT.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
C     KERMIT-AEGIS (Version 1.0) for APOLLO family of super-micro-
C     computers implemented by John Lee of RCA Laboratories 6/29/84
C
C     Permission is granted to any individual or institution to
C     copy or use this program, except for explicitly commerical purpose.
C
C
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /LABNET/ XSOH
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 RESW,X,STATUS,GETLIN,TEMP,AOPEN,AONE,BONE,A1,Z1
      INTEGER*4 XSTATUS,QSECOND
      INTEGER*2 XSPACE(2),WSIO
      LOGICAL XONE,XZERO
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/TIME.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
%INCLUDE '/SYS/INS/SIO.INS.FTN'
      INTEGER*2 ATWO,FINDLN
      INTEGER*2 SCONNECT(8)
      INTEGER*2 MOREFILE(9)
      INTEGER*2 XAPPEND, XREAD,XWRITE,XREADWRITE
      INTEGER*2 VALUE(40)
      INTEGER*2 HELPFILE(12)
      INTEGER*2 IBMOFF(12)
      INTEGER*2 IBMON(11)
      INTEGER*2 STAT(7)
      INTEGER*2 QUIT(5)
      INTEGER*2 SEXIT(5)
      INTEGER*2 HELP(5)
      INTEGER*2 SSEND(5)
      INTEGER*2 RMTTTY(24)
      INTEGER*2 FLAG1,FLAG2,FLAG3,FLAG4,FLAG5,FLAG6,FLAG7,FLAG8,FLAG9
      INTEGER*2 BELL(3)
      INTEGER*2 ALIN(132)
      INTEGER*2 BLIN(132)
      INTEGER*2 DLIN(132)
      INTEGER*2 SLIN(132)
      INTEGER*2 APAT(128)
      INTEGER*2 BPAT(128)
      INTEGER*2 CPAT(128)
      INTEGER*2 DPAT(128)
      INTEGER*2 EPAT(128)
      INTEGER*2 FPAT(128)
      INTEGER*2 GPAT(128)
      INTEGER*2 HPAT(128)
      INTEGER*2 IPAT(128)
      INTEGER*2 XREC(8)
      DATA XREC(1),XREC(2),XREC(3),XREC(4),XREC(5),XREC(6),XREC(7),XREC(
     *8)/82,69,67,69,73,86,69,10002/
      DATA RMTTTY(1),RMTTTY(2),RMTTTY(3),RMTTTY(4),RMTTTY(5),
     +     RMTTTY(6),RMTTTY(7),RMTTTY(8),RMTTTY(9),RMTTTY(10),
     +     RMTTTY(11),RMTTTY(12),RMTTTY(13),RMTTTY(14),RMTTTY(15),
     +     RMTTTY(16),RMTTTY(17),RMTTTY(18),RMTTTY(19),RMTTTY(20),
     +     RMTTTY(21),RMTTTY(22),RMTTTY(23),RMTTTY(24)/47,83,
     +     89,83,47,78,79,68,69,95,68,65,84,65,47,68,69,86,
     +     47,83,73,79,49,10002/
      DATA SSEND(1),SSEND(2),SSEND(3),SSEND(4),SSEND(5)/83,69,78,68,1000
     *2/
      DATA HELP(1),HELP(2),HELP(3),HELP(4),HELP(5)/72,69,76,80,10002/
      DATA SEXIT(1),SEXIT(2),SEXIT(3),SEXIT(4),SEXIT(5)/69,88,73,84,1000
     *2/
      DATA QUIT(1),QUIT(2),QUIT(3),QUIT(4),QUIT(5)/81,85,73,84,10002/
      DATA STAT(1),STAT(2),STAT(3),STAT(4),STAT(5),STAT(6),STAT(7)/83,84
     *,65,84,85,83,10002/
      DATA IBMON(1),IBMON(2),IBMON(3),IBMON(4),IBMON(5),IBMON(6),IBMON(7
     *),IBMON(8),IBMON(9),IBMON(10),IBMON(11)/83,69,84,32,73,66,77,32,79
     *,78,10002/
      DATA IBMOFF(1),IBMOFF(2),IBMOFF(3),IBMOFF(4),IBMOFF(5),IBMOFF(6),I
     *BMOFF(7),IBMOFF(8),IBMOFF(9),IBMOFF(10),IBMOFF(11),IBMOFF(12)/83,6
     *9,84,32,73,66,77,32,79,70,70,10002/
      DATA HELPFILE(1),HELPFILE(2),HELPFILE(3),HELPFILE(4),HELPFILE(5),H
     *ELPFILE(6),HELPFILE(7),HELPFILE(8),HELPFILE(9),HELPFILE(10),HELPFI
     *LE(11),HELPFILE(12)/72,69,76,80,95,75,69,82,77,73,84,10002/
      DATA VALUE(1),VALUE(2),VALUE(3),VALUE(4),VALUE(5),VALUE(6),VALUE(7
     *),VALUE(8),VALUE(9),VALUE(10),VALUE(11),VALUE(12),VALUE(13),VALUE(
     *14),VALUE(15),VALUE(16),VALUE(17),VALUE(18),VALUE(19),VALUE(20),VA
     *LUE(21),VALUE(22),VALUE(23),VALUE(24),VALUE(25),VALUE(26),VALUE(27
     *),VALUE(28),VALUE(29),VALUE(30),VALUE(31),VALUE(32),VALUE(33),VALU
     *E(34),VALUE(35),VALUE(36),VALUE(37),VALUE(38),VALUE(39),VALUE(40)/
     *32,108,111,99,97,108,32,111,102,102,32,32,32,35,32,32,32,32,32,57,
     *52,32,32,32,94,77,32,32,83,73,79,32,32,32,32,32,32,32,32,10002/
      DATA MOREFILE(1),MOREFILE(2),MOREFILE(3),MOREFILE(4),MOREFILE(5),M
     *OREFILE(6),MOREFILE(7),MOREFILE(8),MOREFILE(9)/109,111,114,101,102
     *,105,108,101,10002/
      DATA SCONNECT(1),SCONNECT(2),SCONNECT(3),SCONNECT(4),SCONNECT(5),S
     *CONNECT(6),SCONNECT(7),SCONNECT(8)/67,79,78,78,69,67,84,10002/
      PRINT *,'APOLLO-AEGIS KERMIT VERSION 1.0'
      LOCALINFD=STREAM_$STDIN
      LOCALOUTFD=STREAM_$STDOUT
      QSECOND=10
      MOREFD=-1
      STATE=67
      XAPPEND=3
      XREAD=0
      XREADWRITE=2
      IBM=0
      HOST=-1
      AONE=1
      XSPACE(1)=32
      XSPACE(2)=10002
      BELL(1)=7
      BELL(2)=7
      BELL(3)=10002
      XONE=.TRUE.
      XZERO=.FALSE.
      BONE=1
      ATWO=2
      CALL SCOPY(HELP,AONE,APAT,BONE)
      CALL SCOPY(SEXIT,AONE,BPAT,BONE)
      CALL SCOPY(QUIT,AONE,CPAT,BONE)
      CALL SCOPY(STAT,AONE,DPAT,BONE)
      CALL SCOPY(IBMON,AONE,EPAT,BONE)
      CALL SCOPY(IBMOFF,AONE,FPAT,BONE)
      CALL SCOPY(SSEND,AONE,GPAT,BONE)
      CALL SCOPY(XREC,AONE,HPAT,BONE)
      CALL SCOPY(SCONNECT,AONE,IPAT,BONE)
      CALL SCOPY(VALUE,AONE,SLIN,BONE)
C
      CALL SIO_$INQUIRE(STREAM_$STDIN,SIO_$LINE,WSIO,XSTATUS)
C     WHERE IS THE PROGRAM KERMIT INVOKED FROM ?
C     LOCAL KEYBOARD, SIO1, SIO2, OR SIO3 ??
      IF(XSTATUS.EQ.SIO_$STREAM_NOT_SIO)THEN
C        IT WAS FROM LOCAL KEYBOARD AND THEREFORE KERMIT MUST BE RUN
C        IN LOCAL KERMIT MODE.
         HOST=0
         PRINT *,'Local KERMIT mode now in effect'
         PRINT *,'Which SIO port is to be used'
         PRINT *,'for file transfer (1/2/3) ??'
         STATUS=GETLIN(ALIN,LOCALINFD)
         IF(ALIN(1).EQ.49)THEN
C           USE SIO:1 PORT
            RMTTTY(23)=49
         ELSE IF(ALIN(1).EQ.50)THEN
C                USE SIO:2 PORT
                 RMTTTY(23)=50
         ELSE IF(ALIN(1).EQ.51)THEN
C                USE SIO:3 PORT
                 RMTTTY(23)=51
         ELSE
              PRINT *,'Invalid SIO port slected'
              PRINT *,'Defaulted SIO:1 will be used'
              RMTTTY(23)=49
         ENDIF
         RMTINFD=AOPEN(RMTTTY,XREAD)
C        OPEN THE SIO PORT FOR READING
         IF(RMTINFD.EQ.10001)THEN
            CALL CANT(RMTTTY)
         ELSE
             RMTOUTFD=AOPEN(RMTTTY,XAPPEND)
C            OPEN THE SIO PORT FOR WRITING
             IF(RMTOUTFD.EQ.10001)THEN
                CALL CANT(RMTTTY)
             ENDIF
         ENDIF
      ELSE
C         PROGRAM WAS INVOKED FROM A SIO PORT
          PRINT *,'Remote or Local KERMIT mode (R/L)  ??'
          STATUS=GETLIN(ALIN,LOCALINFD)
          CALL UPPER(ALIN,BLIN)
          IF(BLIN(1).EQ.82)THEN
C             USER TYPE IN THE LETTER R
              PRINT *,'Remote Host KERMIT mode now in effect'
              HOST=-1
              RMTINFD=LOCALINFD
              RMTOUTFD=LOCALOUTFD
C             USED THE CURRENTLY LOGIN SIO PORT FOR FILE TRANSFER
              IF(WSIO.EQ.1)THEN
                 RMTTTY(23)=49
              ELSE IF(WSIO.EQ.2)THEN
                      RMTTTY(23)=50
              ELSE
                   RMTTTY(23)=51
              ENDIF
          ELSE IF(BLIN(1).EQ.76)THEN
C                 USER TYPE IN THE LETTER L
                  PRINT *,'Local KERMIT mode now in effect'
                  PRINT *,'Which SIO port is to be used'
                  PRINT *,'for file transfer (1/2/3) ??'
                  STATUS=GETLIN(ALIN,LOCALINFD)
                  IF((ALIN(1)-48).EQ.WSIO)THEN
                      PRINT *,'SIO port to be used for file transfer'
                      PRINT *,'must be different from the SIO port'
                      PRINT *,'you are currently login under in'
                      PRINT *,'LOCAL KERMIT mode !'
                      CALL RATEXIT
                  ENDIF
                  IF(ALIN(1).EQ.49)THEN
C                    USER SELCTED SIO:1
                     RMTTTY(23)=49
                  ELSE IF(ALIN(1).EQ.50)THEN
C                          USER SELCTED SIO:2
                           RMTTTY(23)=50
                  ELSE IF(ALIN(1).EQ.51)THEN
C                         USER SLECTED SIO:3
                          RMTTTY(23)=51
                  ELSE
                      PRINT *,'Invalid SIO port selected'
                      PRINT *,'Defaulted SIO:1 will be used'
                      RMTTTY(23)=49
                  ENDIF
                  RMTINFD=AOPEN(RMTTTY,XREAD)
C                 OPEN SIO PORT FOR READING
                  IF(RMTINFD.EQ.10001)THEN
                     CALL CANT(RMTTTY)
                  ELSE
                      RMTOUTFD=AOPEN(RMTTTY,XAPPEND)
C                     OPEN SIO PORT FOR WRITING
                      IF(RMTOUTFD.EQ.10001)THEN
                         CALL CANT(RMTTTY)
                      ENDIF
                  ENDIF
             ELSE
                 PRINT *,'Unsupported KERMIT mode, please try again'
                 CALL RATEXIT
             ENDIF
      ENDIF
C     ASK USERS WHICH SOH IS TO BE USED
C
      PRINT *,'What SOH character is to be used'
      PRINT *,'CNTR-A or CNTR-E (A/E) ??'
      STATUS=GETLIN(ALIN,LOCALINFD)
      CALL UPPER(ALIN,BLIN)
      IF(BLIN(1).EQ.65)THEN
C        USER SELCTED CNTR-A
         XSOH=1
       ELSE IF(BLIN(1).EQ.69)THEN
C              USER SLECTED CNTR-E
               XSOH=5
       ELSE
           PRINT *,'Invalid SOH selected'
           PRINT *,'Defaulted to CNTR-A'
           XSOH=1
       ENDIF
C     DO FOREVER

      ISTAT=1
23008 IF(.NOT.(ISTAT.EQ.1))GOTO 23009
C     CALL WRSEQ(LOCALOUTFD,"KERMIT-RDOS>",13,IER)
      PRINT *,'KERMIT-AEGIS>'
      FD=10001
      STATUS=GETLIN(ALIN,LOCALINFD)
      CALL UPPER(ALIN,BLIN)
      A1=1
      FLAG1=FINDLN(BLIN,APAT,A1,Z1)
      A1=1
      FLAG2=FINDLN(BLIN,BPAT,A1,Z1)
      A1=1
      FLAG3=FINDLN(BLIN,CPAT,A1,Z1)
      A1=1
      FLAG4=FINDLN(BLIN,DPAT,A1,Z1)
      A1=1
      FLAG5=FINDLN(BLIN,EPAT,A1,Z1)
      A1=1
      FLAG6=FINDLN(BLIN,FPAT,A1,Z1)
      A1=1
      FLAG7=FINDLN(BLIN,GPAT,A1,Z1)
      A1=1
      FLAG8=FINDLN(BLIN,HPAT,A1,Z1)
      A1=1
      FLAG9=FINDLN(BLIN,IPAT,A1,Z1)
      IF(.NOT.(FLAG1.EQ.1))GOTO 23010
      TEMP=AOPEN(HELPFILE,XREAD)
23012 IF(.NOT.((GETLIN(ALIN,TEMP).NE.10003)))GOTO 23013
      CALL PUTLIN(ALIN,LOCALOUTFD)
      GOTO 23012
23013 CONTINUE
      CALL RATCLOSE(TEMP)
      GOTO 23011
23010 CONTINUE
      IF(.NOT.((FLAG2.EQ.1).OR.(FLAG3.EQ.1)))GOTO 23014
      PRINT *,'Kermit now terminated'
      CALL RATEXIT
      GOTO 23015
23014 CONTINUE
      IF(.NOT.(FLAG4.EQ.1))GOTO 23016
      PRINT *,'                 PACKET '
      PRINT *,' MODE  IBM QUOTE  SIZE  EOL SIO    SPEED STATE'
      PRINT *,'  '
      IF(.NOT.(HOST.EQ.-1))GOTO 23018
      SLIN(1)=32
      SLIN(2)=104
      SLIN(3)=111
      SLIN(4)=115
      SLIN(5)=116
      SLIN(6)=32
      GOTO 23019
23018 CONTINUE
      SLIN(2)=108
      SLIN(3)=111
      SLIN(4)=99
      SLIN(5)=97
      SLIN(6)=108
23019 CONTINUE
      IF(.NOT.(IBM.EQ.-1))GOTO 23020
      SLIN(8)=111
      SLIN(9)=110
      SLIN(10)=32
      SLIN(11)=32
      GOTO 23021
23020 CONTINUE
      SLIN(8)=111
      SLIN(9)=102
      SLIN(10)=102
      SLIN(11)=32
23021 CONTINUE
      IF(.NOT.(HOST.EQ.-1))GOTO 23022
      SLIN(29)=83
      SLIN(30)=73
      SLIN(31)=79
      SLIN(32)=58
      SLIN(33)=RMTTTY(23)
      SLIN(34)=32
      SLIN(35)=32
      SLIN(36)=57
      SLIN(37)=54
      SLIN(38)=48
      SLIN(39)=48
      SLIN(40)=32
      GOTO 23023
23022 CONTINUE
      SLIN(29)=83
      SLIN(30)=73
      SLIN(31)=79
      SLIN(32)=58
      SLIN(33)=RMTTTY(23)
      SLIN(34)=32
      SLIN(35)=32
      SLIN(36)=57
      SLIN(37)=54
      SLIN(38)=48
      SLIN(39)=48
      SLIN(40)=32
23023 CONTINUE
      SLIN(41)=32
      SLIN(42)=32
      SLIN(43)=32
      SLIN(44)=STATE
      SLIN(45)=32
      SLIN(46)=32
      SLIN(47)=10
      SLIN(48)=10002
      CALL PUTLIN(XSPACE,LOCALOUTFD)
      CALL PUTLIN(SLIN,LOCALOUTFD)
      PRINT *,'  '
      GOTO 23017
23016 CONTINUE
      IF(.NOT.(FLAG5.EQ.1))GOTO 23024
      IF(.NOT.(HOST.EQ.-1))GOTO 23026
      PRINT *,'Not supported in Host kermit mode'
      GOTO 23027
23026 CONTINUE
      IBM=-1
23027 CONTINUE
      GOTO 23025
23024 CONTINUE
      IF(.NOT.(FLAG6.EQ.1))GOTO 23028
      IBM=0
      GOTO 23029
23028 CONTINUE
      IF(.NOT.(FLAG7.EQ.1))GOTO 23030
      ITEMP=0
      PRINT *,'enter filename or @filename'
      STATUS=GETLIN(ALIN,LOCALINFD)
      CALL REMOVE(MOREFILE)
      MOREFD=AOPEN(MOREFILE,XAPPEND)
      IF(MOREFD.EQ.10001)CALL RATEXIT
      IF(.NOT.(ALIN(1).NE.64))GOTO 23032
      CALL PUTLIN(ALIN,MOREFD)
      GOTO 23033
23032 CONTINUE
      CALL SCOPY(ALIN,ATWO,DLIN,AONE)
      ITEMP=AOPEN(DLIN,XREAD)
      IF(.NOT.(ITEMP.EQ.10001))GOTO 23034
      PRINT *,'Source file not found'
      GOTO 23035
23034 CONTINUE
23036 IF(.NOT.(GETLIN(ALIN,ITEMP).NE.10003))GOTO 23037
      CALL PUTLIN(ALIN,MOREFD)
      GOTO 23036
23037 CONTINUE
      CALL RATCLOSE(ITEMP)
23035 CONTINUE
23033 CONTINUE
      CALL RATCLOSE(MOREFD)
      IF(.NOT.(ITEMP.NE.10001))GOTO 23038
      IF(.NOT.(HOST.EQ.-1))GOTO 23040
C     CALL WAIT(15,2,IER)
23040 CONTINUE
      CALL SIO_$CONTROL(RMTINFD,SIO_$RAW,XONE,XSTATUS)
      IF(XSTATUS.NE.STATUS_$OK)CALL ERROR_$PRINT(XSTATUS)
      IF(HOST.NE.0)THEN
C                  WE ARE RUNNING IN REMOTE HOST MODE
         CALL SIO_$CONTROL(RMTINFD,SIO_$NO_ECHO,XONE,XSTATUS)
         IF(XSTATUS.NE.STATUS_$OK)THEN
            CALL ERROR_$PRINT(XSTATUS)
            STOP
         ENDIF
      ENDIF
      IF(HOST.EQ.0)GOTO 40
C     WE ARE IN HOST MODE, WAIT 15 SECOND BEFORE SENDING
C     THE FIRST SINIT PACKET
      DO 1 I=1,4
      CALL TIME_$WAIT(TIME_$RELATIVE,QSECOND,XSTATUS)
1     CONTINUE
40    CONTINUE
      STATUS=SENDSW(X)
      CALL SIO_$CONTROL(RMTINFD,SIO_$RAW,XZERO,XSTATUS)
      IF(XSTATUS.NE.STATUS_$OK)CALL ERROR_$PRINT(XSTATUS)
      IF(HOST.NE.0)THEN
C                    WE ARE RUNNING IN REMOTE HOST MODE
         CALL SIO_$CONTROL(RMTINFD,SIO_$NO_ECHO,XZERO,XSTATUS)
         IF(XSTATUS.NE.STATUS_$OK)THEN
            CALL ERROR_$PRINT(XSTATUS)
            STOP
         ENDIF
      ENDIF
      IF(.NOT.(HOST.EQ.0))GOTO 23042
C     CALL WRSEQ(LOCALOUTFD,BELL,2,IER)
      CALL PUTLIN(BELL,LOCALOUTFD)
23042 CONTINUE
      IF(.NOT.((STATUS.EQ.-1).AND.(HOST.EQ.0)))GOTO 23044
      PRINT *,'COMPLETED'
23044 CONTINUE
      IF(.NOT.((STATUS.NE.-1).AND.(HOST.EQ.0)))GOTO 23046
      PRINT *,'FAILED'
23046 CONTINUE
      IF(.NOT.(FD.NE.10001))GOTO 23048
      CALL RATCLOSE(FD)
23048 CONTINUE
23038 CONTINUE
      GOTO 23031
23030 CONTINUE
      IF(.NOT.(FLAG8.EQ.1))GOTO 23050
      CALL SIO_$CONTROL(RMTINFD,SIO_$RAW,XONE,XSTATUS)
      IF(XSTATUS.NE.STATUS_$OK)CALL ERROR_$PRINT(XSTATUS)
      IF(HOST.NE.0)THEN
C                  WE ARE RUNNING IN REMOTE HOST MODE
         CALL SIO_$CONTROL(RMTINFD,SIO_$NO_ECHO,XONE,XSTATUS)
         IF(XSTATUS.NE.STATUS_$OK)THEN
            CALL ERROR_$PRINT(XSTATUS)
            STOP
         ENDIF
      ENDIF
      STATUS=RECSW(X)
      CALL SIO_$CONTROL(RMTINFD,SIO_$RAW,XZERO,XSTATUS)
      IF(XSTATUS.NE.STATUS_$OK)CALL ERROR_$PRINT(XSTATUS)
      IF(HOST.NE.0)THEN
C                  WE ARE RUNNING IN REMOTE HOST MODE
         CALL SIO_$CONTROL(RMTINFD,SIO_$NO_ECHO,XZERO,XSTATUS)
         IF(XSTATUS.NE.STATUS_$OK)THEN
            CALL ERROR_$PRINT(XSTATUS)
            STOP
         ENDIF
      ENDIF
      IF(.NOT.(HOST.EQ.0))GOTO 23052
C     CALL WRSEQ(LOCALOUTFD,BELL,2,IER)
      CALL PUTLIN(BELL,LOCALOUTFD)
23052 CONTINUE
      IF(.NOT.((STATUS.EQ.-1).AND.(HOST.EQ.0)))GOTO 23054
      PRINT *,'COMPLETED'
23054 CONTINUE
      IF(.NOT.((STATUS.NE.-1).AND.(HOST.EQ.0)))GOTO 23056
      PRINT *,'FAILED'
23056 CONTINUE
      IF(.NOT.(FD.NE.10001))GOTO 23058
      CALL RATCLOSE(FD)
23058 CONTINUE
      GOTO 23051
23050 CONTINUE
      IF(.NOT.(FLAG9.EQ.1))GOTO 23060
      IF(.NOT.(HOST.EQ.-1))GOTO 23062
      PRINT *,'Connect is not supported in Host mode'
      GOTO 23063
23062 CONTINUE
      CALL CONNECT(LOCALINFD,LOCALOUTFD,RMTINFD,RMTOUTFD)
23063 CONTINUE
      GOTO 23061
23060 CONTINUE
      PRINT *,'Invalid command, please type HELP'
23061 CONTINUE
23051 CONTINUE
23031 CONTINUE
23029 CONTINUE
23025 CONTINUE
23017 CONTINUE
23015 CONTINUE
23011 CONTINUE
      GOTO 23008
23009 CONTINUE
      END
CCCCCCCCCCCCCCCCCCCCCC KGETCH.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
C     GETCH A CHARACTER FROM A SERIAL LINE ONLY, WITH NO TIME-OUT READ
      INTEGER FUNCTION KGETCH(T,CHAN)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 T,CHAN,X,IER
      INTEGER*4 STATUS,BUFLEN,SEEK_KEY(3),RETLEN
      INTEGER*4 PTRO
      CHARACTER*1 INCHAR,OUTCHAR
      POINTER /PTRO/OUTCHAR
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
      BUFLEN=1
C     PRINT *,'INSIDE THE KGETCH ROUTINE '
      CALL STREAM_$GET_BUF(CHAN,IADDR(INCHAR),BUFLEN,
     +    PTRO,RETLEN,SEEK_KEY,STATUS)
      IF(STATUS.NE.STATUS_$OK)CALL ERROR_$PRINT(STATUS)
      T=ICHAR(OUTCHAR)
C     STRIP OFF THE PARITY BIT
      T=AND(T,16#7F)
C     PRINT *,'THE VALUE OF CHAR IS ',T
      KGETCH=1
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC  KGETLIN.FTN  CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION KGETLIN(BUFFER,CH)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 BUFFER(1)
      INTEGER*2 CH,KGETCH,STATUS,T,COUNT,TEMP
      INTEGER*2 V10,V13,V0
      STATUS=1
      V10=10
      V13=13
      V0=0
      COUNT=1
      KGETLIN=COUNT
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
      TEMP=KGETCH(T,CH)
      BUFFER(COUNT)=T
      IF(.NOT.(T.EQ.V13))GOTO 23002
      BUFFER(COUNT+1)=10002
C     PRINT *,'RETURNING FROM KGETLIN'
      RETURN
23002 CONTINUE
C     PRINT *,'CHAR DOES NOT MATCH'
      COUNT=COUNT+1
23003 CONTINUE
      GOTO 23000
23001 CONTINUE
      PRINT *,'RETURNING FROM KGETLIN'
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC KPUTCH.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE KPUTCH(T,CHAN)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 T
      INTEGER*2 CHAN,IER
      CHARACTER X
      INTEGER*4 BUFLEN,STATUS,SEEK_KEY(3)
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
      BUFLEN=1
C     PRINT *,'INSIDE THE KPUTCH ROUITNE'
      X=CHAR(T)
      CALL STREAM_$PUT_CHR(CHAN,IADDR(X),BUFLEN,
     +                     SEEK_KEY,STATUS)
      IF(STATUS.NE.STATUS_$OK)CALL ERROR_$PRINT(STATUS)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC  PUTLIN.FTN   CCCCCCCCCCCCCCCCCCCCCCCCCC
C     OUTPUT A LINE TO THE LOCAL KEYBOARD OR DISK FILE
      SUBROUTINE PUTLIN(ABUFF,CHAN)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 ABUFF(1), CHAN,COUNT,EOS,T
      CHARACTER INCHAR(132)
      INTEGER*4 BUFLEN,RETLEN,STATUS,SEEK_KEY(3)
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
C      PRINT *,'INSIDE PUTLIN'
      EOS=10002
      COUNT=1
      BUFLEN=0
1     CONTINUE
      T=ABUFF(COUNT)
      IF(T.EQ.EOS)GOTO 100
      INCHAR(COUNT)=CHAR(T)
      COUNT=COUNT+1
      BUFLEN=BUFLEN+1
      GOTO 1
100   CONTINUE
      CALL STREAM_$PUT_REC(CHAN,IADDR(INCHAR),BUFLEN,
     +                     SEEK_KEY,STATUS)
C          CALL STREAM_$FORCE_WRITE_FILE(CHAN,STREAM_$FW_FILE,STATUS)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC RATCLOSE.FTN  CCCCCCCCCCCCCCCCCCCCCCCCCC
C     CLOSE A STREAM-ID
      SUBROUTINE RATCLOSE(FD)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 FD
      INTEGER*4 STATUS
%INCLUDE '/SYS/INS/BASE.INS.FTN'
%INCLUDE '/SYS/INS/STREAMS.INS.FTN'
      CALL STREAM_$CLOSE(FD,STATUS)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC RATEXIT.FTN   CCCCCCCCCCCCCCCCCCCCCCCCCC
C     EXIT FROM A FORTRAN PROGRAM
      SUBROUTINE RATEXIT
      INTEGER A
      PRINT *,'Exiting from the APOLLO-KERMIT program'
      STOP
      END
CCCCCCCCCCCCCCCCCCCCCC RDATA.FTN     CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RDATA(X)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 NUM,LEN,STATUS
      INTEGER*2 X,RPACK,TNUM
      INTEGER*2 BIGA,BIGD,BIGY,V6,V0,BIGN,BIGZ,BIGF
C     PRINT *,'INSIDE THE RDATA ROUTINE'
      BIGA=65
      BIGZ=90
      BIGD=68
      BIGF=70
      BIGY=89
      BIGN=78
      V6=6
      V0=0
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      RDATA=BIGA
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      STATUS=RPACK(LEN,NUM,PACKET)
      IF(.NOT.(HOST.EQ.0))GOTO 23002
      PRINT *, 'Packet # ',NUM
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGD))GOTO 23004
      IF(.NOT.(NUM.NE.N))GOTO 23006
      IF(.NOT.(OLDTRY.GT.5 ))GOTO 23008
      RDATA=BIGA
      RETURN
23008 CONTINUE
      OLDTRY=OLDTRY+1
23009 CONTINUE
      IF(.NOT.(NUM.EQ.(N-1)))GOTO 23010
      CALL SPAR(PACKET)
      CALL SPACK(BIGY,NUM,V6,PACKET)
      NUMTRY=0
      RDATA=STATE
      RETURN
23010 CONTINUE
      RDATA=BIGA
      RETURN
23011 CONTINUE
23006 CONTINUE
      CALL BUFEMP(PACKET,LEN)
      TNUM=N
      CALL SPACK(BIGY,TNUM,V0,V0)
      OLDTRY=NUMTRY
      NUMTRY=0
      N=MOD((N+1),64)
      RDATA=BIGD
      RETURN
23004 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGN))GOTO 23012
      IF(.NOT.(OLDTRY.GT.5 ))GOTO 23014
      RDATA=BIGA
      RETURN
23014 CONTINUE
      OLDTRY=OLDTRY+1
23015 CONTINUE
      IF(.NOT.(NUM.EQ.(N-1)))GOTO 23016
      CALL SPACK(BIGY,NUM,V0,V0)
      NUMTRY=0
      RDATA=STATE
      RETURN
23016 CONTINUE
      RDATA=BIGA
      RETURN
23017 CONTINUE
      GOTO 23013
23012 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGZ))GOTO 23018
      IF(.NOT.(NUM.NE.N))GOTO 23020
      RDATA=BIGA
      RETURN
23020 CONTINUE
      TNUM=N
      CALL SPACK(BIGY,TNUM,V0,V0)
      CALL RATCLOSE(FD)
      N=MOD((N+1),64)
      RDATA=BIGF
      RETURN
23018 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23022
      RDATA=STATE
      TNUM=N
      CALL SPACK(BIGN,TNUM,V0,V0)
      RETURN
23022 CONTINUE
      RDATA=BIGA
23023 CONTINUE
23019 CONTINUE
23013 CONTINUE
23005 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC RECSW.FTN     CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RECSW(X)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 X
      INTEGER*2 RDATA,RFILE,RINIT,STATUS
      INTEGER*2 BIGD,BIGF,BIGR,BIGC,BIGA,VMINUS1,V0
      STATUS=1
      BIGR=82
      BIGF=70
      BIGC=67
      BIGA=65
      VMINUS1=-1
      BIGD=68
      V0=0
      STATE=BIGR
      N=0
      NUMTRY=0
      PAD=0
      NUMTRY=0
      EOL=13
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
      IF(.NOT.(STATE.EQ.BIGD))GOTO 23002
      STATE=RDATA(X)
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATE.EQ.BIGF))GOTO 23004
      STATE=RFILE(X)
      GOTO 23005
23004 CONTINUE
      IF(.NOT.(STATE.EQ.BIGR))GOTO 23006
      STATE=RINIT(X)
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(STATE.EQ.BIGC))GOTO 23008
      RECSW=VMINUS1
      CALL RATCLOSE(FD)
      RETURN
23008 CONTINUE
      IF(.NOT.(STATE.EQ.BIGA))GOTO 23010
      RECSW=V0
      RETURN
23010 CONTINUE
23009 CONTINUE
23007 CONTINUE
23005 CONTINUE
23003 CONTINUE
      GOTO 23000
23001 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC REMOVE.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
C     DELETE A FILE FROM THE WORKING DIRECTORY
      SUBROUTINE REMOVE(FNAME)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 COUNT,CR,LF,EOS,NLENGTH,NULL
      INTEGER*4 STATUS
      CHARACTER INCHAR(132)
      INTEGER*2 FNAME(1)
%INCLUDE '/SYS/INS/NAME.INS.FTN'
      CR=13
      LF=10
      EOS=10002
      NULL=0
      COUNT=1
      NLENGTH=0
1     CONTINUE
      IF((FNAME(COUNT).EQ.CR).OR.(FNAME(COUNT).EQ.LF)
     +    .OR.(FNAME(COUNT).EQ.EOS).OR.(FNAME(COUNT).EQ.NULL))GOTO 100
      INCHAR(COUNT)=CHAR(FNAME(COUNT))
      NLENGTH=COUNT
      COUNT=COUNT+1
      GOTO 1
100   CONTINUE
      CALL NAME_$DELETE_FILE(INCHAR,NLENGTH,STATUS)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC RFILE.FTN     CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RFILE(X)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 NUM,LEN,STATUS,RPACK,X,TNUM
      INTEGER*2 BIGA,BIGS,BIGY,V6,BIGZ,V0,BIGN
      INTEGER*2 BIGF,BIGD,BIGB,BIGC
      INTEGER*2 XAPPEND
      INTEGER*2 AONE,BONE,A12
      INTEGER*2 ALIN(132)
      INTEGER*2 RECEIVING(12)
      DATA RECEIVING(1),RECEIVING(2),RECEIVING(3),RECEIVING(4),RECEIVING
     *(5),RECEIVING(6),RECEIVING(7),RECEIVING(8),RECEIVING(9),RECEIVING(
     *10),RECEIVING(11),RECEIVING(12)/32,82,101,99,101,105,118,105,110,1
     *03,32,10002/
      BIGA=65
      BIGS=83
      BIGY=89
      V6=6
      BIGZ=90
      V0=0
      BIGN=78
      BIGF=70
      BIGD=68
      BIGB=66
      BIGC=67
      XAPPEND=3
C     PRINT *,'INSIDE THE RFILE ROUTINE'
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      RFILE=BIGA
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      STATUS=RPACK(LEN,NUM,PACKET)
      IF(.NOT.(STATUS.EQ.BIGS))GOTO 23002
      IF(.NOT.(OLDTRY.GT.5 ))GOTO 23004
      RFILE=BIGA
      RETURN
23004 CONTINUE
      OLDTRY=OLDTRY+1
23005 CONTINUE
      IF(.NOT.(NUM.EQ.(N-1)))GOTO 23006
      CALL SPAR(PACKET)
      CALL SPACK(BIGY,NUM,V6,PACKET)
      NUMTRY=0
      RFILE=STATE
      RETURN
23006 CONTINUE
      RFILE=BIGA
      RETURN
23007 CONTINUE
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGZ))GOTO 23008
      IF(.NOT.(OLDTRY.GT.5 ))GOTO 23010
      RFILE=BIGA
      RETURN
23010 CONTINUE
      OLDTRY=OLDTRY+1
23011 CONTINUE
      IF(.NOT.(NUM.EQ.(N-1)))GOTO 23012
      CALL SPACK(BIGY,NUM,V0,V0)
      NUMTRY=0
      RFILE=STATE
      RETURN
23012 CONTINUE
      RFILE=BIGA
      RETURN
23013 CONTINUE
      GOTO 23009
23008 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGF))GOTO 23014
      IF(.NOT.(NUM.NE.N))GOTO 23016
      RFILE=BIGA
      RETURN
23016 CONTINUE
      PACKET(LEN+1)=13
      PACKET(LEN+2)=10002
      CALL VERIFY(PACKET)
      IF(.NOT.(HOST.EQ.0))GOTO 23018
      AONE=1
      BONE=1
      A12=12
      CALL SCOPY(RECEIVING,AONE,ALIN,BONE)
      CALL SCOPY(PACKET,AONE,ALIN,A12)
      CALL PUTLIN(ALIN,LOCALOUTFD)
23018 CONTINUE
      FD=AOPEN(PACKET,XAPPEND)
      IF(.NOT.(FD.EQ.10001))GOTO 23020
      RFILE=BIGA
      RETURN
23020 CONTINUE
      TNUM=N
      CALL SPACK(BIGY,TNUM,V0,V0)
      OLDTRY=NUMTRY
      NUMTRY=0
      N=MOD((N+1),64)
      RFILE=BIGD
      RETURN
23014 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGB))GOTO 23022
      IF(.NOT.(NUM.NE.N))GOTO 23024
      RFILE=BIGA
      RETURN
23024 CONTINUE
      TNUM=N
      CALL SPACK(BIGY,TNUM,V0,V0)
      RFILE=BIGC
      RETURN
23022 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23026
      RFILE=STATE
      TNUM=N
      CALL SPACK(BIGN,TNUM,V0,V0)
      RETURN
23026 CONTINUE
      RFILE=BIGA
23027 CONTINUE
23023 CONTINUE
23015 CONTINUE
23009 CONTINUE
23003 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC RINIT.FTN     CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RINIT(X)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 LEN,NUM,STATUS,RPACK,X,TNUM
      INTEGER*2 BIGA,BIGS,BIGY,V6,BIGF,BIGN,V0
C     PRINT *,'INSIDE THE RINIT ROUTINE '
      BIGA=65
      BIGS=83
      BIGY=89
      V6=6
      BIGF=70
      BIGN=78
      V0=0
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      RINIT=BIGA
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      STATUS=RPACK(LEN,NUM,PACKET)
      IF(.NOT.(STATUS.EQ.BIGS))GOTO 23002
      CALL RPAR(PACKET)
      CALL SPAR(PACKET)
      TNUM=N
      CALL SPACK(BIGY,TNUM,V6,PACKET)
      OLDTRY=NUMTRY
      NUMTRY=0
      N=MOD((N+1),64)
      RINIT=BIGF
      RETURN
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23004
      RINIT=STATE
      TNUM=N
      CALL SPACK(BIGN,TNUM,V0,V0)
      RETURN
23004 CONTINUE
      RINIT=BIGA
23005 CONTINUE
23003 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC RPACK.FTN     CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION RPACK(LEN,NUM,XDATA)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /LABNET/ XSOH
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 LEN,NUM,CH
      INTEGER*2 KGETLIN
      INTEGER*2 XDATA(1)
      INTEGER*2 I,COUNT,STATUS,UNCHAR,J,K,IDC1,T1,IBYTE
      INTEGER*2 XCOUNT,TEMP,MAILID
      INTEGER*2 CHKSUM,T,XTYPE,BUFFER(132)
      CHKSUM=0
C     PRINT *,'INSIDE THE RPACK ROUTINE'
      IF(.NOT.(IBM.EQ.-1))GOTO 23000
      XCOUNT=1
      GOTO 23001
23000 CONTINUE
      XCOUNT=1
23001 CONTINUE
      I=1
      CH=RMTINFD
23002 IF(.NOT.(I.LE.XCOUNT))GOTO 23003
      IF(.NOT.(IBM.EQ.-1))GOTO 23004
      STATUS=IBMGETLIN(BUFFER,CH)
      GOTO 23005
23004 CONTINUE
      STATUS=KGETLIN(BUFFER,CH)
23005 CONTINUE
      COUNT=1
23006 IF(.NOT.((BUFFER(COUNT).NE.XSOH ).AND.(BUFFER(COUNT).NE.10002)))
     *GOTO 23007
      COUNT=COUNT+1
      GOTO 23006
23007 CONTINUE
      IF(.NOT.(BUFFER(COUNT).EQ.1 ))GOTO 23008
      K=COUNT+1
      CHKSUM=BUFFER(K)
      LEN=UNCHAR(BUFFER(K))-3
      K=K+1
      CHKSUM=CHKSUM+BUFFER(K)
      NUM=UNCHAR(BUFFER(K))
      K=K+1
      XTYPE=BUFFER(K)
      CHKSUM=CHKSUM+BUFFER(K)
      K=K+1
      J=1
23010 IF(.NOT.(J.LE.LEN))GOTO 23012
      XDATA(J)=BUFFER(K)
      CHKSUM=CHKSUM+BUFFER(K)
      K=K+1
      COUNT=J
23011 J=J+1
      GOTO 23010
23012 CONTINUE
      XDATA(COUNT+1)=0
      T=BUFFER(K)
C     CHKSUM=(CHKSUM+(CHKSUM.AND.192)/64).AND.63
      T1=AND(CHKSUM,192)
      T2=T1/64
      T3=CHKSUM+T2
      CHKSUM=AND(T3,63)
      IF(.NOT.(CHKSUM.NE.UNCHAR(T)))GOTO 23013
      RPACK=0
C     PRINT *,'CHECK SUM FAILED'
      RETURN
23013 CONTINUE
      RPACK=XTYPE
C     PRINT *,'RETURN PACKET HAVE THE RIGHT CHECKSUM'
      RETURN
23008 CONTINUE
      I=I+1
      GOTO 23002
23003 CONTINUE
      RPACK=0
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC RPAR.FTN      CCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE RPAR(XDATA)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 XDATA(1)
      INTEGER*2 UNCHAR,CTL
      SPSIZ=UNCHAR(XDATA(1))
      PAD=UNCHAR(XDATA(3))
      PADCHAR=CTL(XDATA(4))
      EOL=UNCHAR(XDATA(5))
      QUOTE=XDATA(6)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC   SBREAK.FTN  CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SBREAK(X)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 NUM,LEN,RPACK,STATUS,X,TNUM
      INTEGER*2 BIGA,BIGB,V0,BIGN,BIGY,BIGC
C     PRINT *,'INSIDE THE SBREAK ROUTINE '
      BIGA=65
      BIGB=66
      V0=0
      BIGN=78
      BIGY=89
      BIGC=67
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      SBREAK=BIGA
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      TNUM=N
      CALL SPACK(BIGB,TNUM,V0,PACKET)
      STATUS=RPACK(LEN,NUM,RECPKT)
      IF(.NOT.(STATUS.EQ.BIGN))GOTO 23002
      IF(.NOT.(N.NE.(NUM-1)))GOTO 23004
      SBREAK=STATE
      RETURN
23004 CONTINUE
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGY))GOTO 23006
      IF(.NOT.(N.NE.NUM))GOTO 23008
      SBREAK=STATE
      RETURN
23008 CONTINUE
      NUMTRY=0
      N=MOD((N+1),64)
      SBREAK=BIGC
      RETURN
23006 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23010
      SBREAK=STATE
      RETURN
23010 CONTINUE
      SBREAK=BIGA
23011 CONTINUE
23007 CONTINUE
23003 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC  SCOPY.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SCOPY(FROM, I, TO, J)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 FROM(150), TO(150)
      INTEGER*2 I, J, K1, K2
      K2 = J
      K1 = I
23000 IF(.NOT.(FROM(K1) .NE. 10002))GOTO 23002
      TO(K2) = FROM(K1)
      K2 = K2 + 1
23001 K1 = K1 + 1
      GOTO 23000
23002 CONTINUE
      TO(K2) = 10002
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC  SDATA.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SDATA(X)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 X,NUM,LEN,BUFILL,STATUS,RPACK,TNUM
      INTEGER*2 BIGZ,BIGN,BIGA,BIGD,BIGY
C     PRINT *,'INSIDE THE SDATA ROUTINE'
      BIGZ=90
      BIGN=78
      BIGA=65
      BIGD=68
      BIGY=89
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      SDATA=65
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      TNUM=N
      CALL SPACK(BIGD,TNUM,SIZE,PACKET)
      IF(.NOT.(HOST.EQ.0))GOTO 23002
      PRINT *, 'Packet # ',TNUM
23002 CONTINUE
      STATUS=RPACK(LEN,NUM,RECPKT)
      IF(.NOT.((STATUS.EQ.BIGY).AND.(N.EQ.(NUM+1))))GOTO 23004
      STATUS=RPACK(LEN,NUM,RECPKT)
23004 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGN))GOTO 23006
      IF(.NOT.(N.NE.(NUM-1)))GOTO 23008
      SDATA=STATE
      RETURN
23008 CONTINUE
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGY))GOTO 23010
      IF(.NOT.(N.NE.NUM))GOTO 23012
      SDATA=STATE
      RETURN
23012 CONTINUE
      NUMTRY=0
      N=MOD((N+1),64)
      SIZE=BUFILL(PACKET)
C     PRINT *,'THE SIZE OF PACKET IS ',SIZE
      IF(.NOT.(SIZE.EQ.10003))GOTO 23014
      SDATA=BIGZ
      RETURN
23014 CONTINUE
      SDATA=BIGD
      RETURN
23010 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23016
      SDATA=STATE
      RETURN
23016 CONTINUE
      SDATA=BIGA
23017 CONTINUE
23011 CONTINUE
23007 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC SENDSW.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SENDSW(X)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 X,STATUS
      INTEGER*2 SDATA,SFILE,SEOF,SINIT,SBREAK
      INTEGER*2 BIGB,BIGD,BIGF,BIGZ,BIGS,BIGC,VMINUS1,BIGA,V0
      BIGB=66
      BIGS=83
      BIGD=68
      BIGF=70
      BIGZ=90
      BIGA=65
      BIGC=67
      VMINUS1=-1
      V0=0
      STATE=BIGS
      N=0
      PAD=0
      EOL=13
      NUMTRY=0
      STATUS=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
      IF(.NOT.(STATE.EQ.BIGD))GOTO 23002
      STATE=SDATA(X)
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATE.EQ.BIGF))GOTO 23004
      STATE=SFILE(X)
      GOTO 23005
23004 CONTINUE
      IF(.NOT.(STATE.EQ.BIGZ))GOTO 23006
      STATE=SEOF(X)
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(STATE.EQ.BIGS))GOTO 23008
      STATE=SINIT(X)
      GOTO 23009
23008 CONTINUE
      IF(.NOT.(STATE.EQ.BIGB))GOTO 23010
      STATE=SBREAK(X)
      GOTO 23011
23010 CONTINUE
      IF(.NOT.(STATE.EQ.BIGC))GOTO 23012
      SENDSW=VMINUS1
      CALL RATCLOSE(FD)
      CALL RATCLOSE(MOREFD)
      RETURN
23012 CONTINUE
      IF(.NOT.(STATE.EQ.BIGA))GOTO 23014
      SENDSW=V0
      RETURN
23014 CONTINUE
      STATUS=0
      SENDSW=V0
23015 CONTINUE
23013 CONTINUE
23011 CONTINUE
23009 CONTINUE
23007 CONTINUE
23005 CONTINUE
23003 CONTINUE
      GOTO 23000
23001 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC SEOF.FTN     CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SEOF(X)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 NUM,LEN,STATUS,RPACK,X,TNUM,TEMP
      INTEGER*2 XY
      INTEGER*2 XFREAD
      INTEGER*2 ALIN(132)
      INTEGER*2 AONE,BONE
      INTEGER*2 BIGB,BIGY,BIGF,BIGA,BIGZ,V0,BIGN
      XREAD=0
C     PRINT *,'INSIDE THE SEOF ROUTINE'
      BIGB=66
      BIGY=89
      BIGF=70
      BIGA=65
      BIGZ=90
      V0=0
      BIGN=78
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      SEOF=BIGA
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      AONE=1
      BONE=1
      TNUM=N
      CALL SPACK(BIGZ,TNUM,V0,PACKET)
      STATUS=RPACK(LEN,NUM,RECPKT)
      IF(.NOT.(STATUS.EQ.BIGN))GOTO 23002
      IF(.NOT.(N.NE.(NUM-1)))GOTO 23004
      SEOF=STATE
      RETURN
23004 CONTINUE
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGY))GOTO 23006
      IF(.NOT.(N.NE.NUM))GOTO 23008
      SEOF=STATE
      RETURN
23008 CONTINUE
      NUMTRY=0
      CALL RATCLOSE(FD)
      N=MOD((N+1),64)
      TEMP=GETLIN(FILNAM,MOREFD)
      IF(.NOT.(TEMP.EQ.10003))GOTO 23010
      CALL RATCLOSE(MOREFD)
      SEOF=BIGB
      RETURN
23010 CONTINUE
      FD=AOPEN(FILNAM,XREAD)
      IF(.NOT.(FD.EQ.10001))GOTO 23012
      TEMP=1
23014 IF(.NOT.(TEMP.EQ.1))GOTO 23015
      XY=GETLIN(ALIN,MOREFD)
      IF(.NOT.(XY.EQ.10003))GOTO 23016
      SEOF=BIGB
      CALL RATCLOSE(MOREFD)
      RETURN
23016 CONTINUE
      CALL SCOPY(ALIN,AONE,FILNAM,BONE)
      FD=AOPEN(FILANM,XREAD)
      IF(.NOT.(FD.NE.10001))GOTO 23018
      TEMP=0
23018 CONTINUE
23017 CONTINUE
      GOTO 23014
23015 CONTINUE
      SEOF=BIGF
      RETURN
23012 CONTINUE
      SEOF=BIGF
      RETURN
23013 CONTINUE
23011 CONTINUE
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23020
      SEOF=STATE
      RETURN
23020 CONTINUE
      SEOF=BIGA
23021 CONTINUE
23007 CONTINUE
23003 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC  SFILE.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SFILE(X)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 NUM,LEN,COUNT,RPACK,BUFILL,X,TNUM
      INTEGER*2 AONE,ATEN,BONE
      INTEGER*2 ALIN(132)
      INTEGER*2 SENDING(10)
      INTEGER*2 BIGF,BIGN,BIGY,BIGD,BIGA
      DATA SENDING(1),SENDING(2),SENDING(3),SENDING(4),SENDING(5),SENDIN
     *G(6),SENDING(7),SENDING(8),SENDING(9),SENDING(10)/32,83,101,110,10
     *0,105,110,103,32,10002/
      BIGF=70
      BIGN=78
      BIGY=89
      BIGD=68
      BIGA=65
C     PRINT *,'INSIDE THE SFILE ROUTINE '
      IF(.NOT.(HOST.EQ.0))GOTO 23000
      AONE=1
      BONE=1
      ATEN=10
      CALL SCOPY(SENDING,AONE,ALIN,BONE)
      CALL SCOPY(FILNAM,AONE,ALIN,ATEN)
      CALL PUTLIN(ALIN,LOCALOUTFD)
23000 CONTINUE
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23002
      SFILE=65
      RETURN
23002 CONTINUE
      NUMTRY=NUMTRY+1
23003 CONTINUE
      LEN=1
23004 IF(.NOT.(FILNAM(LEN).NE.10002))GOTO 23005
      LEN=LEN+1
      GOTO 23004
23005 CONTINUE
      LEN=LEN-2
      TNUM=N
      CALL SPACK(BIGF,TNUM,LEN,FILNAM)
      STATUS=RPACK(LEN,NUM,RECPKT)
      IF(.NOT.(STATUS.EQ.BIGN))GOTO 23006
      IF(.NOT.(N.NE.(NUM-1)))GOTO 23008
      SFILE=STATE
      RETURN
23008 CONTINUE
      GOTO 23007
23006 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGY))GOTO 23010
      IF(.NOT.(N.NE.NUM))GOTO 23012
      SFILE=STATE
      RETURN
23012 CONTINUE
      NUMTRY=0
      N=MOD((N+1),64)
      SIZE=BUFILL(PACKET)
      SFILE=BIGD
      RETURN
23010 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23014
      SFILE=STATE
      RETURN
23014 CONTINUE
      SFILE=BIGA
      RETURN
23015 CONTINUE
23011 CONTINUE
23007 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC  SINIT.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION SINIT(X)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 NUM,LEN,STATUS,RPACK,X,TNUM,TEMP
      INTEGER*2 XY
      INTEGER*2 XREAD
      INTEGER*2 ALIN(132)
      INTEGER*2 AONE,BONE
      INTEGER*2 MOREFILE(9)
      INTEGER*2 BIGA,BIGS,V6,BIGN,BIGY,BIGF
      DATA MOREFILE(1),MOREFILE(2),MOREFILE(3),MOREFILE(4),MOREFILE(5),M
     *OREFILE(6),MOREFILE(7),MOREFILE(8),MOREFILE(9)/77,79,82,69,70,73,7
     *6,69,10002/
      XREAD=0
      BIGA=65
      BIGS=83
      V6=6
      BIGN=78
      BIGY=89
      BIGF=70
C     PRINT *,'INSIDE THE SINIT ROUTINE '
      IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
      SINIT=BIGA
      RETURN
23000 CONTINUE
      NUMTRY=NUMTRY+1
23001 CONTINUE
      AONE=1
      BONE=1
      CALL SPAR(PACKET)
      TNUM=N
      CALL SPACK(BIGS,TNUM,V6,PACKET)
      STATUS=RPACK(LEN,NUM,RECPKT)
      IF(.NOT.(STATUS.EQ.BIGN))GOTO 23002
      IF(.NOT.(N.NE.(NUM-1)))GOTO 23004
      SINIT=STATE
      RETURN
23004 CONTINUE
      GOTO 23003
23002 CONTINUE
      IF(.NOT.(STATUS.EQ.BIGY))GOTO 23006
      IF(.NOT.(N.NE.NUM))GOTO 23008
      SINIT=STATE
      RETURN
23008 CONTINUE
      CALL RPAR(RECPKT)
      IF(.NOT.(EOL.EQ.0))GOTO 23010
      EOL=13
23010 CONTINUE
      IF(.NOT.(QUOTE.EQ.0))GOTO 23012
      QUOTE=35
23012 CONTINUE
      NUMTRY=0
      N=MOD((N+1),64)
      MOREFD=AOPEN(MOREFILE,XREAD)
      TEMP=1
23014 IF(.NOT.(TEMP.EQ.1))GOTO 23015
      XY=GETLIN(ALIN,MOREFD)
      IF(.NOT.(XY.EQ.10003))GOTO 23016
      SINIT=BIGA
      CALL RATCLOSE(MOREFD)
      RETURN
23016 CONTINUE
      CALL SCOPY(ALIN,AONE,FILNAM,BONE)
      FD=AOPEN(FILNAM,XREAD)
      IF(.NOT.(FD.NE.10001))GOTO 23018
      TEMP=0
23018 CONTINUE
23017 CONTINUE
      GOTO 23014
23015 CONTINUE
      SINIT=BIGF
      RETURN
23006 CONTINUE
      IF(.NOT.(STATUS.EQ.0))GOTO 23020
      SINIT=STATE
      RETURN
23020 CONTINUE
      SINIT=BIGA
23021 CONTINUE
23007 CONTINUE
23003 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC SPACK.FTN     CCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SPACK(XTYPE,NUM,LEN,XDATA)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /LABNET/ XSOH
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 XTYPE,XDATA(1)
      INTEGER*2 NUM,LEN,CH
      INTEGER*2 I,IER,COUNT,TOCHAR
      INTEGER*2 CHKSUM,BUFFER(100)
      CH=RMTOUTFD
      I=1
C     PRINT *,'INSIDE THE SPACK ROUTINE '
23000 IF(.NOT.(I.LE.PAD))GOTO 23001
      CALL KPUTCH(PADCHAR,CH)
      I=I+1
      GOTO 23000
23001 CONTINUE
C     PRINT *,'GOING FOR THE PACKET NOW'
      COUNT=1
      BUFFER(COUNT)=XSOH
      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
      I=1
23002 IF(.NOT.(I.LE.LEN))GOTO 23004
      BUFFER(COUNT)=XDATA(I)
      COUNT=COUNT+1
      CHKSUM=CHKSUM+XDATA(I)
23003 I=I+1
      GOTO 23002
23004 CONTINUE
C     CHKSUM=(CHKSUM+(CHKSUM.AND.192)/64).AND.63
      T1=AND(CHKSUM,192)
      T2=T1/64
      T3=CHKSUM+T2
      CHKSUM=AND(T3,63)
      BUFFER(COUNT)=TOCHAR(CHKSUM)
      COUNT=COUNT+1
      BUFFER(COUNT)=EOL
      BUFFER(COUNT+1)=10002
      COUNT=1
      CH=RMTOUTFD
23005 IF(.NOT.(BUFFER(COUNT).NE.10002))GOTO 23006
      CALL KPUTCH(BUFFER(COUNT),CH)
      COUNT=COUNT+1
      GOTO 23005
23006 CONTINUE
C     PRINT *,'LEAVING FROM THE SPACK ROUTINE'
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC  SPAR.FTN     CCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SPAR(XDATA)
      IMPLICIT INTEGER*2 (A-Z)
      COMMON /KER/ N,RPSIZ,SPSIZ,PAD,NUMTRY,OLDTRY, FD,RMTINFD,RMTOUTFD,
     *STATE,PADCHAR, EOL,ESCHAR,QUOTE,FILNAM(132),RECPKT(94 ), PACKET(94
     * ),SIZE,MOREFD,IBM,HOST, LOCALINFD,LOCALOUTFD,SPEED
      INTEGER*2 XDATA(1)
      INTEGER*2 V94,V0,V13,V35
      INTEGER*2 CTL,TOCHAR
      V94=94
      V0=0
      V13=13
      V35=35
      XDATA(1)=TOCHAR(V94 )
      XDATA(2)=TOCHAR(V0)
      XDATA(3)=TOCHAR(V0 )
      XDATA(4)=CTL(V0 )
      XDATA(5)=TOCHAR(V13 )
      XDATA(6)=V35
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC TOCHAR.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION TOCHAR(CH)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 CH
      TOCHAR=CH+32
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC  UNCHAR.FTN   CCCCCCCCCCCCCCCCCCCCCCCCCC
      INTEGER FUNCTION UNCHAR(CH)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 CH
      UNCHAR=CH-32
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC  UPPER.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE UPPER(ALIN,BLIN)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 ALIN(132)
      INTEGER*2 BLIN(132)
      INTEGER*2 UCASE(27)
      DATA UCASE(1),UCASE(2),UCASE(3),UCASE(4),UCASE(5),UCASE(6),UCASE(7
     *),UCASE(8),UCASE(9),UCASE(10),UCASE(11),UCASE(12),UCASE(13),UCASE(
     *14),UCASE(15),UCASE(16),UCASE(17),UCASE(18),UCASE(19),UCASE(20),UC
     *ASE(21),UCASE(22),UCASE(23),UCASE(24),UCASE(25),UCASE(26),UCASE(27
     *)/65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,8
     *6,87,88,89,90,10002/
      A1=1
23000 IF(.NOT.(ALIN(A1).NE.10002))GOTO 23001
      IF(.NOT.((ALIN(A1).GT.96).AND.(ALIN(A1).LT.123)))GOTO 23002
      BLIN(A1)=UCASE((ALIN(A1)-32-64))
      GOTO 23003
23002 CONTINUE
      BLIN(A1)=ALIN(A1)
23003 CONTINUE
      A1=A1+1
      GOTO 23000
23001 CONTINUE
      BLIN(A1)=10002
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCC VERIFY.FTN    CCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE VERIFY(TFILE)
      IMPLICIT INTEGER*2 (A-Z)
      INTEGER*2 INFILE(132)
      INTEGER*2 OUTFILE(132)
      INTEGER*2 TFILE(132)
      INTEGER*2 AONE,BONE,TEMP
      AONE=1
      BONE=1
      TEMP=1
      CALL UPPER(TFILE,INFILE)
23000 IF(.NOT.(INFILE(TEMP).NE.13))GOTO 23001
      IF(.NOT.((INFILE(TEMP).GT.64).AND.(INFILE(TEMP).LT.91)))GOTO 23002
      OUTFILE(TEMP)=INFILE(TEMP)
      GOTO 23003
23002 CONTINUE
      IF(.NOT.((INFILE(TEMP).GT.47).AND.(INFILE(TEMP).LT.58)))GOTO 23004
      OUTFILE(TEMP)=INFILE(TEMP)
      GOTO 23005
23004 CONTINUE
      OUTFILE(TEMP)=46
23005 CONTINUE
23003 CONTINUE
      TEMP=TEMP+1
      GOTO 23000
23001 CONTINUE
      OUTFILE(TEMP)=10002
      CALL SCOPY(OUTFILE,AONE,TFILE,BONE)
      INFILE(120)=10002
      RETURN
      END