home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
d
/
rdosker.fr
< prev
next >
Wrap
Text File
|
2020-01-01
|
69KB
|
2,249 lines
CCCCCCCCCCCCC BUFEMP.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE BUFEMP(BUFFER,LEN)
IMPLICIT INTEGER (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 BUFFER(1)
INTEGER CH,LEN,CTL
INTEGER 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.10))GOTO 23007
CALL KPUTCH(T,CH)
23007 CONTINUE
23001 I=I+1
GOTO 23000
23002 CONTINUE
RETURN
END
CCCCCCCCCCCCC BUFILL.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION BUFILL(BUFFER)
IMPLICIT INTEGER (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 I,CTL,T,KGETCH,BUFFER(1),CH
I=1
CH=FD
23000 IF(.NOT.(KGETCH(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.13))GOTO 23004
BUFFER(I)=QUOTE
I=I+1
BUFFER(I)=CTL(13)
T=10
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
CCCCCCCCCCCCC CANT.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE CANT(BUF)
INTEGER BUF(132)
CALL PUTLIN(BUF, 2)
CALL REMARK(": can't open.")
CALL RATEXIT
END
CCCCCCCCCCCCC CHKIO.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE CHKIO (FD, IER)
INTEGER FD, IER
IF(.NOT.(IER .EQ. 1 .OR. IER .EQ. 9))GOTO 23000
RETURN
23000 CONTINUE
WRITE (2, 1) IER, FD
CALL MESSAGE('CHKIO -- ERROR TRACEBACK')
1 FORMAT(" *** error code ", I6, " from channel ", I6)
RETURN
END
CCCCCCCCCCCCC CLOSE.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE RATCLOSE (FD)
INTEGER FD
COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
*:15), IC(0:15), MD(0:15)
INTEGER CHANNEL
INTEGER APOS
INTEGER VPOS
INTEGER LINEBUF
INTEGER NC
INTEGER IC
INTEGER MD
IF(.NOT.(0 .LE. FD .AND. FD .LE. 15))GOTO 23000
CALL FLUSH (FD)
CALL CLOSE (FD, IER)
CHANNEL(FD) = 10001
MD(FD) = 2
23000 CONTINUE
RETURN
END
CCCCCCCCCCCCC COMPILE.MC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
MESSAGE Compiling subroutines for installing KERMIT-RDOS
MESSAGE
FORTRAN/P/M BUFEMP
FORTRAN/P/M BUFILL
FORTRAN/P/M CONNECT
FORTRAN/P/M CTL
FORTRAN/P/M FINDLN
FORTRAN/P/M IBMGETLIN
FORTRAN/P/M KERMIT
FORTRAN/P/M KGETCH
FORTRAN/P/M KGETLIN
FORTRAN/P/M KPICK
FORTRAN/P/M KPUTCH
FORTRAN/P/M RDATA
FORTRAN/P/M RECSW
FORTRAN/P/M RFILE
FORTRAN/P/M RINIT
FORTRAN/P/M RPACK
FORTRAN/P/M RPAR
FORTRAN/P/M SDATA
FORTRAN/P/M SENDSW
FORTRAN/P/M SEOF
FORTRAN/P/M SBREAK
FORTRAN/P/M SFILE
FORTRAN/P/M SINIT
FORTRAN/P/M SPACK
FORTRAN/P/M SPAR
FORTRAN/P/M TOCHAR
FORTRAN/P/M UNCHAR
FORTRAN/P/M UPPER
FORTRAN/P/M VERIFY
MESSAGE Compiling all the library subroutines for KERMIT-RDOS
MESSAGE
FORTRAN/P/M CANT
FORTRAN/P/M CHKIO
FORTRAN/P/M CLOSE
FORTRAN/P/M EXIT
FORTRAN/P/M FLUSH
FORTRAN/P/M GETCH
FORTRAN/P/M GETLIN
FORTRAN/P/M ITOC
FORTRAN/P/M LENGTH
FORTRAN/P/M OPEN
FORTRAN/P/M PACK
FORTRAN/P/M PUTC
FORTRAN/P/M PUTCH
FORTRAN/P/M PUTDEC
FORTRAN/P/M PUTINT
FORTRAN/P/M PUTLIN
FORTRAN/P/M PUTSTR
FORTRAN/P/M REMARK
FORTRAN/P/M REMOVE
FORTRAN/P/M SCOPY
FORTRAN/P/M SSCOPY
FORTRAN/P/M STDIO
FORTRAN/P/M STDOPEN
FORTRAN/P/M SETSETUP
MESSAGE All subroutines needed for KERMIT-RDOS have been compiled
CCCCCCCCCCCCC CONNECT.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE CONNECT
IMPLICIT INTEGER (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 ECHAR,T,STATUS,ICHAR,KGETCH,CQ,CS
CS=011423K
CQ=010421K
ECHAR=29
STATUS=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
T=KGETCH(ICHAR,LOCALINFD)
IF(.NOT.(T.EQ.0))GOTO 23002
CALL REMARK("error in I/O using remote TTY")
CALL REMARK("return to Kermit-RDOS")
RETURN
23002 CONTINUE
IF(.NOT.(ICHAR.EQ.ECHAR))GOTO 23004
CALL REMARK("return to Kermit-RDOS")
RETURN
23004 CONTINUE
CALL KPUTCH(ICHAR,RMTOUTFD)
IF(.NOT.(IBM.EQ.-1))GOTO 23006
CALL KPUTCH(ICHAR,LOCALOUTFD)
23006 CONTINUE
23005 CONTINUE
GOTO 23000
23001 CONTINUE
RETURN
END
CCCCCCCCCCCCC CTL.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION CTL(CH)
INTEGER CH
CTL=IXOR(CH,100K)
RETURN
END
CCCCCCCCCCCCC EXIT.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE RATEXIT
COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
*:15), IC(0:15), MD(0:15)
INTEGER CHANNEL
INTEGER APOS
INTEGER VPOS
INTEGER LINEBUF
INTEGER NC
INTEGER IC
INTEGER MD
DO23000 I = 0, 15
CALL FLUSH (I)
23000 CONTINUE
23001 CONTINUE
CALL EXIT
END
CCCCCCCCCCCCC FINDLN.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION FINDLN(LIN,APAT,A1,Z1)
IMPLICIT INTEGER (A-Z)
INTEGER LIN(132)
INTEGER 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
CCCCCCCCCCCCC FLUSH.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE FLUSH(FD)
INTEGER FD
COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
*:15), IC(0:15), MD(0:15)
INTEGER CHANNEL
INTEGER APOS
INTEGER VPOS
INTEGER LINEBUF
INTEGER NC
INTEGER IC
INTEGER MD
IF(.NOT.(0 .LE. FD .AND. FD .LE. 15 .AND. CHANNEL(FD) .NE. 10001))
*GOTO 23000
IF(.NOT.(MD(FD) .EQ. 1 .AND. IC(FD) .GT. 1))GOTO 23002
BYTE(LINEBUF(1,FD),IC(FD)) = 0
CALL WRLIN (FD, LINEBUF(1,FD), NC(FD), IER)
CALL CHKIO (FD, IER)
23002 CONTINUE
IC(FD) = 1
NC(FD) = 0
23000 CONTINUE
RETURN
END
CCCCCCCCCCCCC GETCH.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION GETCH (C, FD)
INTEGER C, FD
COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
*:15), IC(0:15), MD(0:15)
INTEGER CHANNEL
INTEGER APOS
INTEGER VPOS
INTEGER LINEBUF
INTEGER NC
INTEGER IC
INTEGER MD
IF(.NOT.(0 .LE. FD .AND. FD .LE. 15 .AND. CHANNEL(FD) .NE. 10001))
*GOTO 23000
IF(.NOT.(MD(FD) .NE. 0))GOTO 23002
MD(FD) = 0
IC(FD) = 1
NC(FD) = 0
23002 CONTINUE
23004 CONTINUE
IF(.NOT.(NC(FD) .LT. IC(FD)))GOTO 23007
NC(FD) = 0
CALL RDLIN (FD, LINEBUF(1,FD), NC(FD), IER)
CALL CHKIO (FD, IER)
IC(FD) = 1
23007 CONTINUE
IF(.NOT.(NC(FD) .LT. IC(FD)))GOTO 23009
C = 10003
GOTO 23010
23009 CONTINUE
C = BYTE(LINEBUF(1,FD), IC(FD)) .AND. 177K
IC(FD) = IC(FD) + 1
IF(.NOT.(C .EQ. 10))GOTO 23011
C = 0
GOTO 23012
23011 CONTINUE
IF(.NOT.(C .EQ. 13))GOTO 23013
C = 10
23013 CONTINUE
23012 CONTINUE
23010 CONTINUE
23005 IF(.NOT.(C .EQ. 10003 .OR. C .NE. 0))GOTO 23004
23006 CONTINUE
GOTO 23001
23000 CONTINUE
C = 10003
23001 CONTINUE
GETCH=(C)
RETURN
END
CCCCCCCCCCCCC GETLIN.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION GETLIN(LINE, F)
INTEGER LINE(132), C, GETCH
INTEGER F
GETLIN = 0
23000 IF(.NOT.(GETCH(C, F) .NE. 10003))GOTO 23002
IF(.NOT.(C .EQ. 0))GOTO 23003
GOTO 23002
23003 CONTINUE
IF(.NOT.(GETLIN .LT. 132 - 1))GOTO 23005
GETLIN = GETLIN + 1
LINE(GETLIN) = C
23005 CONTINUE
IF(.NOT.(C .EQ. 10 .OR. C .EQ. 12))GOTO 23007
GOTO 23002
23007 CONTINUE
23001 GOTO 23000
23002 CONTINUE
LINE(GETLIN+1) = 10002
IF(.NOT.(GETLIN .EQ. 0 .AND. C .EQ. 10003))GOTO 23009
GETLIN = 10003
23009 CONTINUE
RETURN
END
CCCCCCCCCCCCC HELPKERMIT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
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 CLI.
HELP - Displays the content of this help file.
QUIT - QUIT from this KERMIT program and returns to the CLI.
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
- will then 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 from CMS before sending out the next
- packet. The program actually looks for the CMS prompt
- of BELL (7).
STATUS - Displays the current values of various setting.
CCCCCCCCCCCCC IBMGETLIN.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION IBMGETLIN(BUFFER,CH)
IMPLICIT INTEGER (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 BUFFER(132)
INTEGER CH,IDC1,STATUS,COUNT,IBYTE,T,GETSOH
IDC1=021K
IBELL=007K
STATUS=1
GETSOH=0
COUNT=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
23002 IF(.NOT.(GETSOH.EQ.0))GOTO 23003
IBYTE=0
CALL RDSEQ(CH,IBYTE,1,IER)
T=ISHIFT(IBYTE,-8) .AND. 177K
IF(.NOT.(T.EQ.1 ))GOTO 23004
GETSOH=1
BUFFER(COUNT)=T
COUNT=COUNT+1
23004 CONTINUE
GOTO 23002
23003 CONTINUE
IBYTE=0
CALL RDSEQ(CH,IBYTE,1,IER)
T=ISHIFT(IBYTE,-8) .AND. 177K
IF(.NOT.(T.EQ.IBELL))GOTO 23006
STATUS=0
GOTO 23007
23006 CONTINUE
BUFFER(COUNT)=T
COUNT=COUNT+1
23007 CONTINUE
GOTO 23000
23001 CONTINUE
BUFFER(COUNT)=10002
RETURN
END
CCCCCCCCCCCCC ITOC.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION ITOC(INT, STR, SIZE)
INTEGER IABS, MOD
INTEGER I, INT, INTVAL, J, K, SIZE
INTEGER STR(10000)
INTVAL = IABS(INT)
STR(1) = 10002
I = 1
23000 CONTINUE
I = I + 1
STR(I) = 48 + MOD(INTVAL,10)
INTVAL = INTVAL / 10
23001 IF(.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE))GOTO 23000
23002 CONTINUE
IF(.NOT.(INT .LT. 0 .AND. I .LT. SIZE))GOTO 23003
I = I + 1
STR(I) = 45
23003 CONTINUE
ITOC = I - 1
J = 1
23005 IF(.NOT.(J .LT. I))GOTO 23007
K = STR(I)
STR(I) = STR(J)
STR(J) = K
I = I - 1
23006 J = J + 1
GOTO 23005
23007 CONTINUE
RETURN
END
CCCCCCCCCCCCC KERMIT.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Implemented by John Lee of RCA Laboratories for Data General
C family of mini-computers running RDOS operating system.
C
C Permission is granted to any individual or institution to
C use or copy this program, except for explicitly commercial
C purpose.
C
C John Lee
C RCA Laboratories
C 609-734-3157
C 7/9/84
C
IMPLICIT INTEGER (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 RESW,X,STATUS,GETLIN,TEMP,AOPEN,AONE,BONE,A1,Z1
INTEGER ATWO,FINDLN
INTEGER FLAG1,FLAG2,FLAG3,FLAG4,FLAG5,FLAG6,FLAG7,FLAG8,FLAG9
INTEGER BELL(3)
INTEGER INTTY(5)
INTEGER OUTTTY(5)
INTEGER ALIN(132)
INTEGER BLIN(132)
INTEGER DLIN(132)
INTEGER SLIN(132)
INTEGER APAT(128)
INTEGER BPAT(128)
INTEGER CPAT(128)
INTEGER DPAT(128)
INTEGER EPAT(128)
INTEGER FPAT(128)
INTEGER GPAT(128)
INTEGER HPAT(128)
INTEGER IPAT(128)
INTEGER ITTY(132)
INTEGER OTTY(132)
INTEGER 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/
INTEGER RMTTTY(6)
DATA RMTTTY(1),RMTTTY(2),RMTTTY(3),RMTTTY(4),RMTTTY(5),RMTTTY(6)/8
*1,84,89,58,51,10002/
INTEGER SSEND(5)
DATA SSEND(1),SSEND(2),SSEND(3),SSEND(4),SSEND(5)/83,69,78,68,1000
*2/
INTEGER HELP(5)
DATA HELP(1),HELP(2),HELP(3),HELP(4),HELP(5)/72,69,76,80,10002/
INTEGER SEXIT(5)
DATA SEXIT(1),SEXIT(2),SEXIT(3),SEXIT(4),SEXIT(5)/69,88,73,84,1000
*2/
INTEGER QUIT(5)
DATA QUIT(1),QUIT(2),QUIT(3),QUIT(4),QUIT(5)/81,85,73,84,10002/
INTEGER STAT(7)
DATA STAT(1),STAT(2),STAT(3),STAT(4),STAT(5),STAT(6),STAT(7)/83,84
*,65,84,85,83,10002/
INTEGER IBMON(11)
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/
INTEGER IBMOFF(12)
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/
INTEGER HELPFILE(11)
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)/72,69,76,80,75,69,82,77,73,84,10002/
INTEGER VALUE(41)
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),
*VALUE(41)/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,36,84,84,73,32,32,32,32,32,32,32
*,32,10002/
INTEGER MOREFILE(9)
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/
INTEGER SCONNECT(8)
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/
CALL STDOPEN
MOREFD=-1
STATE=67
BELL(1)='<BEL><BEL>'
BELL(2)='<BEL><BEL>'
BELL(3)='<BEL><BEL>'
IBM=0
HOST=-1
AONE=1
BONE=1
ATWO=2
LOCALINFD=0
LOCALOUTFD=1
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)
CALL REMARK("KERMIT-RDOS Version 1.0")
HOST=0
CALL REMARK("Local kermit now in effect")
RMTINFD=RATOPEN(RMTTTY,0)
IF(.NOT.(RMTINFD.EQ.10001))GOTO 23000
CALL CANT(RMTTTY)
23000 CONTINUE
RMTOUTFD=RATOPEN(RMTTTY,1)
IF(.NOT.(RMTOUTFD.EQ.10001))GOTO 23002
CALL CANT(RMTTTY)
23002 CONTINUE
ISTAT=1
23004 IF(.NOT.(ISTAT.EQ.1))GOTO 23005
CALL WRSEQ(LOCALOUTFD,"Kermit-RDOS>",12,IER)
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 23006
TEMP=RATOPEN(HELPFILE,0)
23008 IF(.NOT.((GETLIN(ALIN,TEMP).NE.10003)))GOTO 23009
CALL PUTLIN(ALIN,LOCALOUTFD)
GOTO 23008
23009 CONTINUE
CALL RATCLOSE(TEMP)
GOTO 23007
23006 CONTINUE
IF(.NOT.((FLAG2.EQ.1).OR.(FLAG3.EQ.1)))GOTO 23010
CALL REMARK("Kermit now terminated")
CALL RATEXIT
GOTO 23011
23010 CONTINUE
IF(.NOT.(FLAG4.EQ.1))GOTO 23012
CALL REMARK(" PACKET ")
CALL REMARK(" MODE IBM QUOTE SIZE EOL TTY SPEED STATE")
CALL REMARK(" ")
IF(.NOT.(HOST.EQ.-1))GOTO 23014
SLIN(2)=104
SLIN(3)=111
SLIN(4)=115
SLIN(5)=116
SLIN(6)=32
GOTO 23015
23014 CONTINUE
SLIN(2)=108
SLIN(3)=111
SLIN(4)=99
SLIN(5)=97
SLIN(6)=108
23015 CONTINUE
IF(.NOT.(IBM.EQ.-1))GOTO 23016
SLIN(8)=111
SLIN(9)=110
SLIN(10)=32
SLIN(11)=32
GOTO 23017
23016 CONTINUE
SLIN(8)=111
SLIN(9)=102
SLIN(10)=102
SLIN(11)=32
23017 CONTINUE
IF(.NOT.(HOST.EQ.-1))GOTO 23018
SLIN(29)=36
SLIN(30)=84
SLIN(31)=84
SLIN(32)=73
SLIN(33)=32
SLIN(34)=32
GOTO 23019
23018 CONTINUE
SLIN(29)=81
SLIN(30)=84
SLIN(31)=89
SLIN(32)=58
SLIN(33)=51
SLIN(34)=32
SLIN(35)=32
SLIN(36)=57
SLIN(37)=54
SLIN(38)=48
SLIN(39)=48
SLIN(40)=32
23019 CONTINUE
SLIN(41)=32
SLIN(42)=32
SLIN(43)=32
SLIN(44)=STATE
SLIN(45)=32
SLIN(46)=32
SLIN(47)=13
SLIN(48)=10002
CALL PUTLIN(SLIN,LOCALOUTFD)
CALL REMARK(" ")
GOTO 23013
23012 CONTINUE
IF(.NOT.(FLAG5.EQ.1))GOTO 23020
IF(.NOT.(HOST.EQ.-1))GOTO 23022
CALL REMARK("Not supported in host kermit mode")
GOTO 23023
23022 CONTINUE
IBM=-1
23023 CONTINUE
GOTO 23021
23020 CONTINUE
IF(.NOT.(FLAG6.EQ.1))GOTO 23024
IBM=0
GOTO 23025
23024 CONTINUE
IF(.NOT.(FLAG7.EQ.1))GOTO 23026
ITEMP=0
CALL REMARK("enter filename or @filename")
STATUS=GETLIN(ALIN,0)
CALL REMOVE(MOREFILE)
MOREFD=RATOPEN(MOREFILE,1)
IF(.NOT.(MOREFD.EQ.10001))GOTO 23028
CALL CANT(MOREFILE)
23028 CONTINUE
IF(.NOT.(ALIN(1).NE.64))GOTO 23030
CALL PUTLIN(ALIN,MOREFD)
GOTO 23031
23030 CONTINUE
CALL SCOPY(ALIN,ATWO,DLIN,AONE)
J=1
23032 IF(.NOT.(DLIN(J).NE.10002))GOTO 23033
IF(.NOT.(DLIN(J).EQ.10))GOTO 23034
DLIN(J)=13
23034 CONTINUE
J=J+1
GOTO 23032
23033 CONTINUE
ITEMP=RATOPEN(DLIN,0)
IF(.NOT.(ITEMP.EQ.10001))GOTO 23036
CALL REMARK("Indirect Source file not found")
GOTO 23037
23036 CONTINUE
I=1
23038 IF(.NOT.(I.EQ.1))GOTO 23039
J=GETLIN(ALIN,ITEMP)
IF(.NOT.(J.NE.10003))GOTO 23040
CALL PUTLIN(ALIN,MOREFD)
GOTO 23041
23040 CONTINUE
I=0
23041 CONTINUE
GOTO 23038
23039 CONTINUE
CALL RATCLOSE(ITEMP)
23037 CONTINUE
23031 CONTINUE
CALL RATCLOSE(MOREFD)
IF(.NOT.(ITEMP.NE.10001))GOTO 23042
IF(.NOT.(HOST.EQ.-1))GOTO 23044
CALL WAIT(15,2,IER)
23044 CONTINUE
STATUS=SENDSW(X)
IF(.NOT.(HOST.EQ.0))GOTO 23046
CALL WRSEQ(LOCALOUTFD,BELL(1),6,IER)
23046 CONTINUE
CALL REMARK(" ")
IF(.NOT.((STATUS.EQ.-1).AND.(HOST.EQ.0)))GOTO 23048
CALL REMARK("COMPLETED")
23048 CONTINUE
IF(.NOT.((STATUS.NE.-1).AND.(HOST.EQ.0)))GOTO 23050
CALL REMARK("FAILED")
23050 CONTINUE
CALL REMARK(" ")
IF(.NOT.(FD.NE.10001))GOTO 23052
CALL RATCLOSE(FD)
23052 CONTINUE
23042 CONTINUE
GOTO 23027
23026 CONTINUE
IF(.NOT.(FLAG8.EQ.1))GOTO 23054
STATUS=RECSW(X)
IF(.NOT.(HOST.EQ.0))GOTO 23056
CALL WRSEQ(LOCALOUTFD,BELL(1),6,IER)
23056 CONTINUE
CALL REMARK(" ")
IF(.NOT.((STATUS.EQ.-1).AND.(HOST.EQ.0)))GOTO 23058
CALL REMARK("COMPLETED")
23058 CONTINUE
IF(.NOT.((STATUS.NE.-1).AND.(HOST.EQ.0)))GOTO 23060
CALL REMARK("FAILED")
23060 CONTINUE
CALL REMARK(" ")
IF(.NOT.(FD.NE.10001))GOTO 23062
CALL RATCLOSE(FD)
23062 CONTINUE
GOTO 23055
23054 CONTINUE
IF(.NOT.(FLAG9.EQ.1))GOTO 23064
IF(.NOT.(HOST.EQ.-1))GOTO 23066
CALL REMARK("Connect is not supported in Host mode")
GOTO 23067
23066 CONTINUE
TASK KPICK, ID=1, PRI=1
CALL CONNECT
CALL TIDK(1,IER)
CALL CHECK(IER)
CALL WAIT(2,2,IER)
CALL RATCLOSE(RMTINFD)
CALL RATCLOSE(RMTOUTFD)
RMTINFD=RATOPEN(RMTTTY,0)
IF(.NOT.(RMTINFD.EQ.10001))GOTO 23068
CALL CANT(RMTTTY)
23068 CONTINUE
RMTOUTFD=RATOPEN(RMTTTY,1)
IF(.NOT.(RMTOUTFD.EQ.10001))GOTO 23070
CALL CANT(RMTTTY)
23070 CONTINUE
23067 CONTINUE
GOTO 23065
23064 CONTINUE
CALL REMARK("Invalid command, please type HELP")
23065 CONTINUE
23055 CONTINUE
23027 CONTINUE
23025 CONTINUE
23021 CONTINUE
23013 CONTINUE
23011 CONTINUE
23007 CONTINUE
GOTO 23004
23005 CONTINUE
RETURN
END
CCCCCCCCCCCCC KGETCH.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION KGETCH(T,XCHAN)
INTEGER T,XCHAN,X,IER
CALL RDSEQ(XCHAN,X,1,IER)
IF(.NOT.(IER.NE.1))GOTO 23000
GOTO 100
23000 CONTINUE
T=ISHIFT(X,-8) .AND. 177K
KGETCH=1
RETURN
100 CONTINUE
KGETCH=0
RETURN
END
CCCCCCCCCCCCC KGETLIN.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION KGETLIN(BUFFER,CH)
IMPLICIT INTEGER (A-Z)
INTEGER BUFFER(132)
INTEGER CH,KGETCH,STATUS,T,COUNT,TEMP
STATUS=1
COUNT=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
TEMP=KGETCH(T,CH)
BUFFER(COUNT)=T
IF(.NOT.(T.EQ.13))GOTO 23002
BUFFER(COUNT+1)=10002
RETURN
23002 CONTINUE
COUNT=COUNT+1
23003 CONTINUE
GOTO 23000
23001 CONTINUE
RETURN
END
CCCCCCCCCCCCC KPICK.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE KPICK
IMPLICIT INTEGER (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 IBYTE,STATUS,CS,CQ,COUNT
INTEGER ALIN(132)
CS=011423K
CQ=010421K
STATUS=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
CALL RDSEQ(RMTINFD,IBYTE,1,IER)
CALL WRSEQ(LOCALOUTFD,IBYTE,1,IER)
GOTO 23000
23001 CONTINUE
RETURN
END
CCCCCCCCCCCCC KPUTCH.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE KPUTCH(T,CHAN)
INTEGER T
INTEGER CH,IER,X
X=ISHIFT(T,8)
CALL WRSEQ(CHAN,X,1,IER)
IF(.NOT.(IER.NE.1))GOTO 23000
TYPE "error in kputch ",IER
23000 CONTINUE
RETURN
END
CCCCCCCCCCCCC LINKALL.LD CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
/KERMIT.LD
DELETE KERMIT.MP
RLDR/P/D/N/E KERMIT/S KERMIT.MP/L 4/K 17/C ^
kermit rpack spack sinit sfile verify rpar spar recsw bufill bufemp ^
rfile seof sdata ibmgetlin kgetch rinit sendsw kpick rdata ^
tochar kputch findln connect sbreak unchar ^
kgetlin ctl upper stdopen stdio stdsetup remove open close cant ^
remark exit putdec putint putc getlin putlin putstr getch putch flush ^
chkio itoc length scopy pack sscopy ^
@TFLIBLONG@
CCCCCCCCCCCCC LENGTH.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION LENGTH(STR)
INTEGER STR(10000)
LENGTH = 0
23000 IF(.NOT.(STR(LENGTH+1) .NE. 10002))GOTO 23002
23001 LENGTH = LENGTH + 1
GOTO 23000
23002 CONTINUE
RETURN
END
CCCCCCCCCCCCC OPEN.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION RATOPEN (NAME, MODE)
INTEGER NAME(10000)
INTEGER MODE
COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
*:15), IC(0:15), MD(0:15)
INTEGER CHANNEL
INTEGER APOS
INTEGER VPOS
INTEGER LINEBUF
INTEGER NC
INTEGER IC
INTEGER MD
INTEGER STRING(40), CH
I = 1
23000 IF(.NOT.(NAME(I) .EQ. 32))GOTO 23002
23001 I = I+1
GOTO 23000
23002 CONTINUE
J = 1
23003 IF(.NOT.(NAME(I) .NE. 10002))GOTO 23005
BYTE(STRING,J) = NAME(I)
J = J+1
23004 I = I+1
GOTO 23003
23005 CONTINUE
BYTE(STRING,J) = 0
CH = 0
23006 IF(.NOT.(CH .LE. 15))GOTO 23008
IF(.NOT.(CHANNEL(CH) .EQ. 10001))GOTO 23009
GOTO 23008
23009 CONTINUE
23007 CH = CH+1
GOTO 23006
23008 CONTINUE
IF(.NOT.(CH .GT. 15))GOTO 23011
IER = 10001
GOTO 23012
23011 CONTINUE
IF(.NOT.(MODE .EQ. 0))GOTO 23013
CALL OPEN (CH, STRING, 1, IER)
GOTO 23014
23013 CONTINUE
IF(.NOT.(MODE .EQ. 1 .OR. MODE .EQ. 2))GOTO 23015
CALL CFILW (STRING, 2, IER)
CALL OPEN (CH, STRING, 3, IER)
23015 CONTINUE
23014 CONTINUE
23012 CONTINUE
IF(.NOT.(IER .NE. 1))GOTO 23017
WRITE (2, 1) IER, CH, MODE, STRING(1)
1 FORMAT(" open error=",I5,", ch=",I2, ", mode=",I2,", file=",S20)
CH = 10001
GOTO 23018
23017 CONTINUE
CHANNEL(CH) = MODE
23018 CONTINUE
RATOPEN=(CH)
RETURN
END
CCCCCCCCCCCCC PACK.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION PACK (RSTRING, STRING, MAX0)
INTEGER STRING(10000), RSTRING(MAX0)
I = 1
23000 IF(.NOT.(I .LT. MAX0))GOTO 23002
BYTE(STRING,I) = RSTRING(I)
IF(.NOT.(RSTRING(I) .EQ. 10002))GOTO 23003
GOTO 23002
23003 CONTINUE
23001 I = I + 1
GOTO 23000
23002 CONTINUE
BYTE(STRING,I) = 0
PACK=(I-1)
RETURN
END
CCCCCCCCCCCCC PUTC.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE PUTC(C)
INTEGER C
CALL PUTCH(C, 1)
RETURN
END
CCCCCCCCCCCCC PUTCH.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE PUTCH (C, FD)
INTEGER C, FD
COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
*:15), IC(0:15), MD(0:15)
INTEGER CHANNEL
INTEGER APOS
INTEGER VPOS
INTEGER LINEBUF
INTEGER NC
INTEGER IC
INTEGER MD
IF(.NOT.(0 .LE. FD .AND. FD .LE. 15 .AND. CHANNEL(FD) .NE. 10001))
*GOTO 23000
IF(.NOT.(MD(FD) .NE. 1))GOTO 23002
MD(FD) = 1
IC(FD) = 1
NC(FD) = 0
23002 CONTINUE
IF(.NOT.(C .EQ. 10))GOTO 23004
BYTE(LINEBUF(1,FD),IC(FD)) = 13
IC(FD) = IC(FD) + 1
CALL FLUSH (FD)
GOTO 23005
23004 CONTINUE
BYTE(LINEBUF(1,FD),IC(FD)) = C
IC(FD) = IC(FD) + 1
IF(.NOT.(IC(FD) .GT. 132 .OR. C .EQ. 13))GOTO 23006
CALL WRSEQ (FD, LINEBUF(1,FD), IC(FD), IER)
CALL CHKIO (FD, IER)
IC(FD) = 1
GOTO 23007
23006 CONTINUE
IF(.NOT.(C .EQ. 12 .OR. C .EQ. 0))GOTO 23008
CALL FLUSH (FD)
23008 CONTINUE
23007 CONTINUE
23005 CONTINUE
23000 CONTINUE
RETURN
END
CCCCCCCCCCCCC PUTDEC.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE PUTDEC(N, W)
INTEGER N, W
CALL PUTINT(N, W, 1)
RETURN
END
CCCCCCCCCCCCC PUTINT.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE PUTINT(N, W, F)
INTEGER N, W, F
INTEGER CHARS(10)
INTEGER ITOC
INTEGER JUNK
JUNK = ITOC(N, CHARS, 10)
CALL PUTSTR(CHARS, W, F)
RETURN
END
CCCCCCCCCCCCC PUTLIN.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE PUTLIN(B, F)
INTEGER B(10000)
INTEGER F, I
I = 1
23000 IF(.NOT.(B(I) .NE. 10002))GOTO 23002
CALL PUTCH(B(I), F)
23001 I = I + 1
GOTO 23000
23002 CONTINUE
RETURN
END
CCCCCCCCCCCCC PUTSTR.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE PUTSTR(STR, W, F)
INTEGER STR(132)
INTEGER W, F, LEN, I, LENGTH
LEN = LENGTH(STR)
IF(.NOT.(W .GE. 0))GOTO 23000
I = LEN + 1
23002 IF(.NOT.(I .LE. W))GOTO 23004
CALL PUTCH(32, F)
23003 I = I + 1
GOTO 23002
23004 CONTINUE
23000 CONTINUE
I = 1
23005 IF(.NOT.(STR(I) .NE. 10002))GOTO 23007
CALL PUTCH(STR(I), F)
23006 I = I + 1
GOTO 23005
23007 CONTINUE
IF(.NOT.(W .LT. 0))GOTO 23008
I = LEN + 1
23010 IF(.NOT.(I .LE. -W))GOTO 23012
CALL PUTCH(32, F)
23011 I = I + 1
GOTO 23010
23012 CONTINUE
23008 CONTINUE
RETURN
END
CCCCCCCCCCCCC RDATA.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION RDATA(X)
IMPLICIT INTEGER (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 NUM,LEN,STATUS
INTEGER X,RPACK,TNUM
INTEGER XPACK(10)
DATA XPACK(1),XPACK(2),XPACK(3),XPACK(4),XPACK(5),XPACK(6),XPACK(7
*),XPACK(8),XPACK(9),XPACK(10)/80,97,99,107,101,116,32,35,32,10002/
IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
RDATA=65
RETURN
23000 CONTINUE
NUMTRY=NUMTRY+1
23001 CONTINUE
STATUS=RPACK(LEN,NUM,PACKET)
IF(.NOT.(HOST.EQ.0))GOTO 23002
CALL PUTDEC(NUM,4)
CALL PUTC(13)
CALL FLUSH(1)
23002 CONTINUE
IF(.NOT.(STATUS.EQ.68))GOTO 23004
IF(.NOT.(NUM.NE.N))GOTO 23006
IF(.NOT.(OLDTRY.GT.5 ))GOTO 23008
RDATA=65
RETURN
23008 CONTINUE
OLDTRY=OLDTRY+1
23009 CONTINUE
IF(.NOT.(NUM.EQ.(N-1)))GOTO 23010
CALL SPAR(PACKET)
CALL SPACK(89,NUM,6,PACKET)
NUMTRY=0
RDATA=STATE
RETURN
23010 CONTINUE
RDATA=65
RETURN
23011 CONTINUE
23006 CONTINUE
CALL BUFEMP(PACKET,LEN)
TNUM=N
CALL SPACK(89,TNUM,0,0)
OLDTRY=NUMTRY
NUMTRY=0
N=MOD((N+1),64)
RDATA=68
RETURN
23004 CONTINUE
IF(.NOT.(STATUS.EQ.70))GOTO 23012
IF(.NOT.(OLDTRY.GT.5 ))GOTO 23014
RDATA=65
RETURN
23014 CONTINUE
OLDTRY=OLDTRY+1
23015 CONTINUE
IF(.NOT.(NUM.EQ.(N-1)))GOTO 23016
CALL SPACK(89,NUM,0,0)
NUMTRY=0
RDATA=STATE
RETURN
23016 CONTINUE
RDATA=65
RETURN
23017 CONTINUE
GOTO 23013
23012 CONTINUE
IF(.NOT.(STATUS.EQ.90))GOTO 23018
IF(.NOT.(NUM.NE.N))GOTO 23020
RDATA=65
RETURN
23020 CONTINUE
TNUM=N
CALL SPACK(89,TNUM,0,0)
CALL RATCLOSE(FD)
N=MOD((N+1),64)
RDATA=70
RETURN
23018 CONTINUE
IF(.NOT.(STATUS.EQ.0))GOTO 23022
RDATA=STATE
TNUM=N
CALL SPACK(78,TNUM,0,0)
RETURN
23022 CONTINUE
RDATA=65
23023 CONTINUE
23019 CONTINUE
23013 CONTINUE
23005 CONTINUE
RETURN
END
CCCCCCCCCCCCC RECSW.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION RECSW(X)
IMPLICIT INTEGER (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 X
INTEGER RDATA,RFILE,RINIT,STATUS
STATUS=1
STATE=82
N=0
NUMTRY=0
EOL=13
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
IF(.NOT.(STATE.EQ.68))GOTO 23002
STATE=RDATA(X)
GOTO 23003
23002 CONTINUE
IF(.NOT.(STATE.EQ.70))GOTO 23004
STATE=RFILE(X)
GOTO 23005
23004 CONTINUE
IF(.NOT.(STATE.EQ.82))GOTO 23006
STATE=RINIT(X)
GOTO 23007
23006 CONTINUE
IF(.NOT.(STATE.EQ.67))GOTO 23008
RECSW=-1
RETURN
23008 CONTINUE
IF(.NOT.(STATE.EQ.65))GOTO 23010
RECSW=0
RETURN
23010 CONTINUE
23009 CONTINUE
23007 CONTINUE
23005 CONTINUE
23003 CONTINUE
GOTO 23000
23001 CONTINUE
RETURN
END
CCCCCCCCCCCCC REMARK.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE REMARK (STRING)
INTEGER STRING
INTEGER C
I=1
23000 CONTINUE
C = BYTE(STRING,I)
IF(.NOT.(C .EQ. 0))GOTO 23003
GOTO 23002
23003 CONTINUE
CALL PUTCH (C, 2)
23001 I=I+1
GOTO 23000
23002 CONTINUE
CALL PUTCH (10, 2)
RETURN
END
CCCCCCCCCCCCC REMOVE.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE REMOVE(NAME)
INTEGER NAME(50)
INTEGER PNAME(50)
INTEGER PACK, IER
IER = PACK (NAME, PNAME, 50)
CALL DFILW (PNAME, IER)
RETURN
END
CCCCCCCCCCCCC RFILE.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION RFILE(X)
IMPLICIT INTEGER (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 NUM,LEN,STATUS,RPACK,X,TNUM
INTEGER AONE,BONE,A12
INTEGER ALIN(132)
INTEGER 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/
IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
RFILE=65
RETURN
23000 CONTINUE
NUMTRY=NUMTRY+1
23001 CONTINUE
STATUS=RPACK(LEN,NUM,PACKET)
IF(.NOT.(STATUS.EQ.83))GOTO 23002
IF(.NOT.(OLDTRY.GT.5 ))GOTO 23004
RFILE=65
RETURN
23004 CONTINUE
OLDTRY=OLDTRY+1
23005 CONTINUE
IF(.NOT.(NUM.EQ.(N-1)))GOTO 23006
CALL SPAR(PACKET)
CALL SPACK(89,NUM,6,PACKET)
NUMTRY=0
RFILE=STATE
RETURN
23006 CONTINUE
RFILE=65
RETURN
23007 CONTINUE
GOTO 23003
23002 CONTINUE
IF(.NOT.(STATUS.EQ.90))GOTO 23008
IF(.NOT.(OLDTRY.GT.5 ))GOTO 23010
RFILE=65
RETURN
23010 CONTINUE
OLDTRY=OLDTRY+1
23011 CONTINUE
IF(.NOT.(NUM.EQ.(N-1)))GOTO 23012
CALL SPACK(89,NUM,0,0)
NUMTRY=0
RFILE=STATE
RETURN
23012 CONTINUE
RFILE=65
RETURN
23013 CONTINUE
GOTO 23009
23008 CONTINUE
IF(.NOT.(STATUS.EQ.70))GOTO 23014
IF(.NOT.(NUM.NE.N))GOTO 23016
RFILE=65
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)
ALIN(1)=10
ALIN(2)=10002
CALL PUTLIN(ALIN,LOCALOUTFD)
CALL REMARK(" Packet # ")
23018 CONTINUE
FD=RATOPEN(PACKET,1)
IF(.NOT.(FD.EQ.10001))GOTO 23020
CALL CANT(PACKET)
RFILE=65
RETURN
23020 CONTINUE
TNUM=N
CALL SPACK(89,TNUM,0,0)
ODLTRY=NUMTRY
NUMTRY=0
N=MOD((N+1),64)
RFILE=68
RETURN
23014 CONTINUE
IF(.NOT.(STATUS.EQ.66))GOTO 23022
IF(.NOT.(NUM.NE.N))GOTO 23024
RFILE=65
RETURN
23024 CONTINUE
TNUM=N
CALL SPACK(89,TNUM,0,0)
RFILE=67
RETURN
23022 CONTINUE
IF(.NOT.(STATUS.EQ.0))GOTO 23026
RFILE=STATE
TNUM=N
CALL SPACK(78,TNUM,0,0)
RETURN
23026 CONTINUE
RFILE=65
23027 CONTINUE
23023 CONTINUE
23015 CONTINUE
23009 CONTINUE
23003 CONTINUE
RETURN
END
CCCCCCCCCCCCC RINIT.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION RINIT(X)
IMPLICIT INTEGER (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 LEN,NUM,STATUS,RPACK,X,TNUM
IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
RINIT=65
RETURN
23000 CONTINUE
NUMTRY=NUMTRY+1
23001 CONTINUE
STATUS=RPACK(LEN,NUM,PACKET)
IF(.NOT.(STATUS.EQ.83))GOTO 23002
CALL RPAR(PACKET)
CALL SPAR(PACKET)
TNUM=N
CALL SPACK(89,TNUM,6,PACKET)
OLDTRY=NUMTRY
NUMTRY=0
N=MOD((N+1),64)
RINIT=70
RETURN
23002 CONTINUE
IF(.NOT.(STATUS.EQ.0))GOTO 23004
RINIT=STATE
TNUM=N
CALL SPACK(78,TNUM,0,0)
RETURN
23004 CONTINUE
RINIT=65
23005 CONTINUE
23003 CONTINUE
RETURN
END
CCCCCCCCCCCCC RPACK.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION RPACK(LEN,NUM,XDATA)
IMPLICIT INTEGER (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 LEN,NUM,CH
INTEGER KGETLIN,IBMGETLIN
INTEGER XDATA(1)
INTEGER I,COUNT,STATUS,UNCHAR,J,K,IDC1,T1,IBYTE
INTEGER XCOUNT,TEMP,MAILID
INTEGER CHKSUM,T,XTYPE,BUFFER(132)
IDC1=03400K
CHKSUM=0
IF(.NOT.(IBM.EQ.-1))GOTO 23000
XCOUNT=8
GOTO 23001
23000 CONTINUE
XCOUNT=2
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.1 ).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)
CHKSUM=(CHKSUM+(CHKSUM.AND.192)/64).AND.63
IF(.NOT.(CHKSUM.NE.UNCHAR(T)))GOTO 23013
RPACK=0
RETURN
23013 CONTINUE
RPACK=XTYPE
RETURN
23008 CONTINUE
I=I+1
GOTO 23002
23003 CONTINUE
RPACK=0
RETURN
END
CCCCCCCCCCCCC RPAR.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE RPAR(XDATA)
IMPLICIT INTEGER (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 XDATA(1)
INTEGER UNCHAR,CTL
SPSIZ=UNCHAR(XDATA(1))
PAD=UNCHAR(XDATA(3))
PADCHAR=CTL(XDATA(4))
EOL=UNCHAR(XDATA(5))
QUOTE=XDATA(6)
RETURN
END
CCCCCCCCCCCCC SBREAK.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION SBREAK(X)
IMPLICIT INTEGER (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 NUM,LEN,RPACK,STATUS,X,TNUM
IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
SBREAK=65
RETURN
23000 CONTINUE
NUMTRY=NUMTRY+1
23001 CONTINUE
TNUM=N
CALL SPACK(66,TNUM,0,PACKET)
STATUS=RPACK(LEN,NUM,RECPKT)
IF(.NOT.(STATUS.EQ.78))GOTO 23002
IF(.NOT.(N.NE.(NUM-1)))GOTO 23004
SBREAK=STATE
RETURN
23004 CONTINUE
GOTO 23003
23002 CONTINUE
IF(.NOT.(STATUS.EQ.89))GOTO 23006
IF(.NOT.(N.NE.NUM))GOTO 23008
SBREAK=STATE
RETURN
23008 CONTINUE
NUMTRY=0
N=MOD((N+1),64)
SBREAK=67
RETURN
23006 CONTINUE
IF(.NOT.(STATUS.EQ.0))GOTO 23010
SBREAK=STATE
RETURN
23010 CONTINUE
SBREAK=65
23011 CONTINUE
23007 CONTINUE
23003 CONTINUE
RETURN
END
CCCCCCCCCCCCC SCOPY.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE SCOPY(FROM, I, TO, J)
INTEGER FROM(10000), TO(10000)
INTEGER 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
CCCCCCCCCCCCC SDATA.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION SDATA(X)
IMPLICIT INTEGER (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 XPACK(10)
DATA XPACK(1),XPACK(2),XPACK(3),XPACK(4),XPACK(5),XPACK(6),XPACK(7
*),XPACK(8),XPACK(9),XPACK(10)/80,97,99,107,101,116,32,35,32,10002/
INTEGER X,NUM,LEN,BUFILL,STATUS,RPACK,TNUM
IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
SDATA=65
RETURN
23000 CONTINUE
NUMTRY=NUMTRY+1
23001 CONTINUE
TNUM=N
CALL SPACK(68,TNUM,SIZE,PACKET)
IF(.NOT.(HOST.EQ.0))GOTO 23002
CALL PUTDEC(NUM,4)
CALL PUTC(13)
CALL FLUSH(1)
23002 CONTINUE
STATUS=RPACK(LEN,NUM,RECPKT)
IF(.NOT.((STATUS.EQ.89).AND.(N.EQ.(NUM+1))))GOTO 23004
STATUS=RPACK(LEN,NUM,RECPKT)
23004 CONTINUE
IF(.NOT.(STATUS.EQ.78))GOTO 23006
IF(.NOT.(N.NE.(NUM-1)))GOTO 23008
SDATA=STATE
RETURN
23008 CONTINUE
GOTO 23007
23006 CONTINUE
IF(.NOT.(STATUS.EQ.89))GOTO 23010
IF(.NOT.(N.NE.NUM))GOTO 23012
SDATA=STATE
RETURN
23012 CONTINUE
NUMTRY=0
N=MOD((N+1),64)
SIZE=BUFILL(PACKET)
IF(.NOT.(SIZE.EQ.10003))GOTO 23014
SDATA=90
RETURN
23014 CONTINUE
SDATA=68
RETURN
23010 CONTINUE
IF(.NOT.(STATUS.EQ.0))GOTO 23016
SDATA=STATE
RETURN
23016 CONTINUE
SDATA=65
23017 CONTINUE
23011 CONTINUE
23007 CONTINUE
RETURN
END
CCCCCCCCCCCCC SENDSW.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION SENDSW(X)
IMPLICIT INTEGER (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 X,STATUS
INTEGER SDATA,SFILE,SEOF,SINIT,SBREAK
STATE=83
N=0
EOL=13
NUMTRY=0
STATUS=1
23000 IF(.NOT.(STATUS.EQ.1))GOTO 23001
IF(.NOT.(STATE.EQ.68))GOTO 23002
STATE=SDATA(X)
GOTO 23003
23002 CONTINUE
IF(.NOT.(STATE.EQ.70))GOTO 23004
STATE=SFILE(X)
GOTO 23005
23004 CONTINUE
IF(.NOT.(STATE.EQ.90))GOTO 23006
STATE=SEOF(X)
GOTO 23007
23006 CONTINUE
IF(.NOT.(STATE.EQ.83))GOTO 23008
STATE=SINIT(X)
GOTO 23009
23008 CONTINUE
IF(.NOT.(STATE.EQ.66))GOTO 23010
STATE=SBREAK(X)
GOTO 23011
23010 CONTINUE
IF(.NOT.(STATE.EQ.67))GOTO 23012
SENDSW=-1
RETURN
23012 CONTINUE
IF(.NOT.(STATE.EQ.65))GOTO 23014
SENDSW=0
RETURN
23014 CONTINUE
STATUS=0
SENDSW=0
23015 CONTINUE
23013 CONTINUE
23011 CONTINUE
23009 CONTINUE
23007 CONTINUE
23005 CONTINUE
23003 CONTINUE
GOTO 23000
23001 CONTINUE
RETURN
END
CCCCCCCCCCCCC SEOF.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION SEOF(X)
IMPLICIT INTEGER (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 NUM,LEN,STATUS,RPACK,X,TNUM,TEMP
INTEGER XY
INTEGER ALIN(132)
INTEGER AONE,BONE
IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
SEOF=65
RETURN
23000 CONTINUE
NUMTRY=NUMTRY+1
23001 CONTINUE
AONE=1
BONE=1
TNUM=N
CALL SPACK(90,TNUM,0,PACKET)
STATUS=RPACK(LEN,NUM,RECPKT)
IF(.NOT.(STATUS.EQ.78))GOTO 23002
IF(.NOT.(N.NE.(NUM-1)))GOTO 23004
SEOF=STATE
RETURN
23004 CONTINUE
GOTO 23003
23002 CONTINUE
IF(.NOT.(STATUS.EQ.89))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=66
RETURN
23010 CONTINUE
K=1
23012 IF(.NOT.(FILNAM(K).NE.10002))GOTO 23013
IF(.NOT.(FILNAM(K).EQ.10))GOTO 23014
FILNAM(K)=13
23014 CONTINUE
K=K+1
GOTO 23012
23013 CONTINUE
FD=RATOPEN(FILNAM,0)
IF(.NOT.(FD.EQ.10001))GOTO 23016
TEMP=1
23018 IF(.NOT.(TEMP.EQ.1))GOTO 23019
XY=GETLIN(ALIN,MOREFD)
IF(.NOT.(XY.EQ.10003))GOTO 23020
SEOF=66
CALL RATCLOSE(MOREFD)
RETURN
23020 CONTINUE
CALL SCOPY(ALIN,AONE,FILNAM,BONE)
FD=RATOPEN(FILANM,0)
IF(.NOT.(FD.NE.10001))GOTO 23022
TEMP=0
23022 CONTINUE
23021 CONTINUE
GOTO 23018
23019 CONTINUE
SEOF=70
RETURN
23016 CONTINUE
SEOF=70
RETURN
23017 CONTINUE
23011 CONTINUE
GOTO 23007
23006 CONTINUE
IF(.NOT.(STATUS.EQ.0))GOTO 23024
SEOF=STATE
RETURN
23024 CONTINUE
SEOF=65
23025 CONTINUE
23007 CONTINUE
23003 CONTINUE
RETURN
END
CCCCCCCCCCCCC SFILE.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION SFILE(X)
IMPLICIT INTEGER (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 NUM,LEN,COUNT,RPACK,BUFILL,X,TNUM
INTEGER AONE,ATEN,BONE
INTEGER ALIN(132)
INTEGER SENDING(10)
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/
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)
ALIN(1)=10
ALIN(2)=10002
CALL PUTLIN(ALIN,LOCALOUTFD)
CALL REMARK(" Packet #")
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(70,TNUM,LEN,FILNAM)
STATUS=RPACK(LEN,NUM,RECPKT)
IF(.NOT.(STATUS.EQ.78))GOTO 23006
IF(.NOT.(N.NE.(NUM-1)))GOTO 23008
SFILE=STATE
RETURN
23008 CONTINUE
GOTO 23007
23006 CONTINUE
IF(.NOT.(STATUS.EQ.89))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=68
RETURN
23010 CONTINUE
IF(.NOT.(STATUS.EQ.0))GOTO 23014
SFILE=STATE
RETURN
23014 CONTINUE
SFILE=65
RETURN
23015 CONTINUE
23011 CONTINUE
23007 CONTINUE
RETURN
END
CCCCCCCCCCCCC SINIT.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION SINIT(X)
IMPLICIT INTEGER (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 NUM,LEN,STATUS,RPACK,X,TNUM,TEMP
INTEGER XY,JJ
INTEGER ALIN(132)
INTEGER AONE,BONE
INTEGER MOREFILE(9)
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/
INTEGER TFILE(5)
DATA TFILE(1),TFILE(2),TFILE(3),TFILE(4),TFILE(5)/116,101,115,116,
*10002/
IF(.NOT.(NUMTRY.GT.5 ))GOTO 23000
SINIT=65
RETURN
23000 CONTINUE
NUMTRY=NUMTRY+1
23001 CONTINUE
AONE=1
BONE=1
CALL SPAR(PACKET)
TNUM=N
CALL SPACK(83,TNUM,6,PACKET)
STATUS=RPACK(LEN,NUM,RECPKT)
IF(.NOT.(STATUS.EQ.78))GOTO 23002
IF(.NOT.(N.NE.(NUM-1)))GOTO 23004
SINIT=STATE
RETURN
23004 CONTINUE
GOTO 23003
23002 CONTINUE
IF(.NOT.(STATUS.EQ.89))GOTO 23006
IF(.NOT.(N.NE.NUM))GOTO 23008
SINIT=STATE
CALL REMARK("num seq don't match in sinit")
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=RATOPEN(MOREFILE,0)
TEMP=1
23014 IF(.NOT.(TEMP.EQ.1))GOTO 23015
XY=GETLIN(ALIN,MOREFD)
IF(.NOT.(XY.EQ.10003))GOTO 23016
SINIT=65
CALL RATCLOSE(MOREFD)
RETURN
23016 CONTINUE
CALL SCOPY(ALIN,AONE,FILNAM,BONE)
I=1
23018 IF(.NOT.(FILNAM(I).NE.10002))GOTO 23019
IF(.NOT.(FILNAM(I).EQ.10))GOTO 23020
FILNAM(I)=13
23020 CONTINUE
I=I+1
GOTO 23018
23019 CONTINUE
FD=RATOPEN(FILNAM,0)
IF(.NOT.(FD.NE.10001))GOTO 23022
TEMP=0
23022 CONTINUE
23017 CONTINUE
GOTO 23014
23015 CONTINUE
SINIT=70
RETURN
23006 CONTINUE
IF(.NOT.(STATUS.EQ.0))GOTO 23024
SINIT=STATE
RETURN
23024 CONTINUE
SINIT=65
23025 CONTINUE
23007 CONTINUE
23003 CONTINUE
RETURN
END
CCCCCCCCCCCCC SPACK.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE SPACK(XTYPE,NUM,LEN,XDATA)
IMPLICIT INTEGER (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 XTYPE,XDATA(1)
INTEGER NUM,LEN,CH
INTEGER I,IER,COUNT,TOCHAR
INTEGER CHKSUM,BUFFER(100)
CH=RMTOUTFD
I=1
23000 IF(.NOT.(I.LE.PAD))GOTO 23001
CALL KPUTCH(PADCHAR,CH)
I=I+1
GOTO 23000
23001 CONTINUE
COUNT=1
BUFFER(COUNT)=1
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
CHKSUM=(CHKSUM+(CHKSUM.AND.192)/64).AND.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
RETURN
END
CCCCCCCCCCCCC SPAR.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE SPAR(XDATA)
IMPLICIT INTEGER (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 XDATA(1)
INTEGER CTL,TOCHAR
XDATA(1)=TOCHAR(94 )
XDATA(2)=TOCHAR(0)
XDATA(3)=TOCHAR(0 )
XDATA(4)=CTL(0 )
XDATA(5)=TOCHAR(13 )
XDATA(6)=35
RETURN
END
CCCCCCCCCCCCC SSCOPY.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE SSCOPY (FROM, TO)
INTEGER FROM(1), TO(1)
I = 0
23000 CONTINUE
I=I+1
TO(I)=FROM(I)
23001 IF(.NOT.(((TO(I).AND.177400K).EQ.0) .OR. ((TO(I).AND.377K).EQ.0)))
*GOTO 23000
23002 CONTINUE
RETURN
END
CCCCCCCCCCCCC STDIO.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE STDIO (STDIN, STDOUT, STDERR, STDCOM) ;00003
INTEGER STDIN, STDOUT, STDERR, STDCOM ;00004
INCLUDE "F5ERR.FR" ;NEEDED TO DEFINE EREOF BELOW ;00072
PARAMETER NULL = 0 ;ASCII NULL ;00074
PARAMETER DEL = 255 ;ASCII DEL ;00075
INTEGER ARG(70), SW(2) ;00077
INTEGER INNAME(70), OUTNAME(70), ERRNAME(70) ;00078
LOGICAL ISET, OSET, PIPE ;00079
LOGICAL APPOUT, DELERR ;00080
LOGICAL PSW, ISW, OSW, LSW, ESW, ASW, DSW ;00081
LOGICAL NULLARG, COMEOF ;00082
COMMON /STD/ SINNAME, SOUTNAME, SERRNAME, LPTNAME ;00084
INTEGER SINNAME(3), SOUTNAME(4), SERRNAME(4), LPTNAME(3) ;00085
DATA SINNAME / "ST", "DI", "N<0>" / ;00086
DATA SOUTNAME / "ST", "DO", "UT", 0 / ;00087
DATA SERRNAME / "ST", "DE", "RR", 0 / ;00088
DATA LPTNAME / "$L", "PT", 0 / ;00089
CALL SSCOPY (SINNAME, INNAME) ;00093
CALL GCOUT (OUTNAME, IER) ;00094
CALL GCOUT (ERRNAME, IER) ;00095
ISET = .FALSE. ;00096
OSET = .FALSE. ;00097
PIPE = .FALSE. ;00098
COMEOF = .FALSE. ;00099
CALL COMINIT(STDCOM,IER) ;00102
CALL CHECK(IER) ;00103
ASSIGN 32758 TO I32759 ;00106
GO TO 32759 ;00106
32758 IF(.NOT.(PSW)) GO TO 32757 ;00107
ASSIGN 32755 TO I32756 ;00107
GO TO 32756 ;00107
32755 CONTINUE ;00107
32757 IF(.NOT.(ISW)) GO TO 32754 ;00108
ASSIGN 32752 TO I32753 ;00108
GO TO 32753 ;00108
32752 CONTINUE ;00108
32754 IF(.NOT.(OSW)) GO TO 32751 ;00109
ASSIGN 32749 TO I32750 ;00109
GO TO 32750 ;00109
32749 CONTINUE ;00109
32751 IF(.NOT.(LSW)) GO TO 32748 ;00110
ASSIGN 32746 TO I32747 ;00110
GO TO 32747 ;00110
32746 CONTINUE ;00110
32748 IF(.NOT.(ESW)) GO TO 32745 ;00111
ASSIGN 32743 TO I32744 ;00111
GO TO 32744 ;00111
32743 CONTINUE ;00111
32745 APPOUT = ASW ;00112
DELERR = DSW ;00113
32742 CONTINUE ;00116
ASSIGN 32740 TO I32759 ;00117
GO TO 32759 ;00117
32740 IF(COMEOF) GO TO 32741 ;00118
IF(.NOT.(PSW)) GO TO 32739 ;00119
ASSIGN 32738 TO I32756 ;00120
GO TO 32756 ;00120
32738 DELERR = DELERR .OR. DSW ;00121
APPOUT = APPOUT .OR. ASW ;00122
32739 IF(.NOT.(ISW)) GO TO 32737 ;00124
IF(.NOT.(NULLARG)) GO TO 32733 ;00125
ASSIGN 32736 TO I32753 ;00125
GO TO 32753 ;00125
32732 CONTINUE ;00126
32736 CONTINUE ;00127
32737 IF(.NOT.(OSW)) GO TO 32731 ;00128
IF(.NOT.(NULLARG)) GO TO 32729 ;00129
ASSIGN 32730 TO I32750 ;00129
GO TO 32750 ;00129
32729 ASSIGN 32726 TO I32727 ;00130
GO TO 32727 ;00130
32726 CONTINUE ;00130
32730 CONTINUE ;00131
32731 IF(.NOT.(LSW)) GO TO 32725 ;00132
IF(.NOT.(NULLARG)) GO TO 32723 ;00133
ASSIGN 32724 TO I32747 ;00133
GO TO 32747 ;00133
32723 ASSIGN 32721 TO I32727 ;00134
GO TO 32727 ;00134
32721 CONTINUE ;00134
32724 CONTINUE ;00135
32725 IF(.NOT.(ESW)) GO TO 32742 ;00136
IF(.NOT.(NULLARG)) GO TO 32716 ;00137
ASSIGN 32719 TO I32744 ;00137
GO TO 32744 ;00137
32715 CONTINUE ;00138
32719 CONTINUE ;00139
GO TO 32742 ;00140
32741 IF(.NOT.(PIPE)) GO TO 32714 ;00142
CALL DFILW (SINNAME, IER) ;00143
CALL RENAME (SOUTNAME, SINNAME, IER) ;00144
32714 IF(.NOT.(STDIN .GE. 0)) GO TO 32713 ;00148
CALL OPEN (STDIN, INNAME, 2, IER) ;00149
32713 IF(.NOT.(STDOUT .GE. 0)) GO TO 32712 ;00152
IF(.NOT.(APPOUT)) CALL DFILW (OUTNAME, IER) ;00153
CALL CFILW (OUTNAME, 2, IER) ;00154
CALL APPEND (STDOUT, OUTNAME, 0, IER) ;00155
IF (IER .NE. 1) STOP "Can't open STDOUT" ;00156
32712 IF(.NOT.(STDERR .GE. 0)) GO TO 32711 ;00159
IF (DELERR) CALL DFILW (ERRNAME, IER) ;00160
CALL CFILW (ERRNAME, 2, IER) ;00161
CALL APPEND (STDERR, ERRNAME, 0, IER) ;00162
IF (IER .NE. 1) STOP "Can't open STDERR" ;00163
32711 RETURN ;00166
32759 CONTINUE ;00168
CALL COMARG(STDCOM,ARG,SW,IER) ;00169
IF (IER .NE. 1 .AND. IER .NE. EREOF) CALL CHECK(IER) ;00170
COMEOF = (IER .NE. 1) .OR. BYTE(ARG,1) .EQ. DEL ;00172
NULLARG = COMEOF .OR. BYTE(ARG,1) .EQ. NULL ;00173
PSW = ITEST(SW(1), 0) .EQ. 1 ;00175
ISW = ITEST(SW(1), 7) .EQ. 1 ;00176
OSW = ITEST(SW(1), 1) .EQ. 1 ;00177
LSW = ITEST(SW(1), 4) .EQ. 1 ;00178
ESW = ITEST(SW(1),11) .EQ. 1 ;00179
DSW = ITEST(SW(1),12) .EQ. 1 ;00180
ASW = ITEST(SW(1),15) .EQ. 1 ;00181
GO TO I32759 ;00182
32756 CONTINUE ;00184
IF(.NOT.(ISET)) CALL SSCOPY (SINNAME, INNAME) ;00185
IF(.NOT.(OSET)) CALL SSCOPY (SOUTNAME, OUTNAME) ;00186
ISET = .TRUE. ;00187
OSET = .TRUE. ;00188
PIPE = .TRUE. ;00189
GO TO I32756 ;00190
32753 CONTINUE ;00192
CALL GCIN (INNAME, IER) ;00193
ISET = .TRUE. ;00194
GO TO I32753 ;00195
32750 CONTINUE ;00197
CALL SSCOPY (SOUTNAME, OUTNAME) ;00198
OSET = .TRUE. ;00199
GO TO I32750 ;00200
32747 CONTINUE ;00202
CALL SSCOPY (LPTNAME, OUTNAME) ;00203
OSET = .TRUE. ;00204
GO TO I32747 ;00205
32744 CONTINUE ;00207
CALL SSCOPY (SERRNAME, ERRNAME) ;00208
GO TO I32744 ;00209
32733 CONTINUE ;00211
CALL SSCOPY (ARG, INNAME) ;00212
ISET = .TRUE. ;00213
GO TO 32732 ;00214
32727 CONTINUE ;00216
CALL SSCOPY (ARG, OUTNAME) ;00217
OSET = .TRUE. ;00218
GO TO I32727 ;00219
32716 CONTINUE ;00221
CALL SSCOPY (ARG, ERRNAME) ;00222
GO TO 32715 ;00223
END ;00225
CCCCCCCCCCCCC STDOPEN.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE STDOPEN
COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
*:15), IC(0:15), MD(0:15)
INTEGER CHANNEL
INTEGER APOS
INTEGER VPOS
INTEGER LINEBUF
INTEGER NC
INTEGER IC
INTEGER MD
CALL STDIO (0, 1, 2, 3)
CALL STDSETUP(0, 1, 2)
RETURN
END
CCCCCCCCCCCCC STDSETUP.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE STDSETUP (FDI, FDO, FDE)
INTEGER FDI, FDO, FDE
COMMON /CHANNEL/ CHANNEL(0:15), APOS, VPOS, LINEBUF(68,0:15), NC(0
*:15), IC(0:15), MD(0:15)
INTEGER CHANNEL
INTEGER APOS
INTEGER VPOS
INTEGER LINEBUF
INTEGER NC
INTEGER IC
INTEGER MD
DATA CHANNEL /10001, 15*10001/
DATA APOS / 32767 /
DATA VPOS / 32767 /
DATA NC / 0, 15*0 /
DATA IC / 1, 15*1 /
DATA MD / 2, 15*2 /
CHANNEL(3) = 0
CHANNEL(6) = 1
CHANNEL(10) = 1
CHANNEL(11) = 0
CHANNEL(12) = 1
IF(.NOT.(FDI.GE.0))GOTO 23000
CHANNEL(FDI) = 0
23000 CONTINUE
IF(.NOT.(FDO.GE.0))GOTO 23002
CHANNEL(FDO) = 1
23002 CONTINUE
IF(.NOT.(FDE.GE.0))GOTO 23004
CHANNEL(FDE) = 1
23004 CONTINUE
RETURN
END
CCCCCCCCCCCCC TOCHAR.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION TOCHAR(CH)
INTEGER CH
TOCHAR=CH+32
RETURN
END
CCCCCCCCCCCCC UNCHAR.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION UNCHAR(CH)
INTEGER CH
UNCHAR=CH-32
RETURN
END
CCCCCCCCCCCCC UPPER.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE UPPER(ALIN,BLIN)
IMPLICIT INTEGER (A-Z)
INTEGER ALIN(132)
INTEGER BLIN(132)
INTEGER 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
CCCCCCCCCCCCC VERIFY.FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE VERIFY(INFILE)
INTEGER INFILE(132)
INTEGER OUTFILE(132)
INTEGER AONE,BONE,TEMP
AONE=1
BONE=1
TEMP=1
23000 IF(.NOT.((INFILE(TEMP).NE.10002).AND.(INFILE(TEMP).NE.13)))GOTO 23
*001
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,INFILE,BONE)
INFILE(11)=10002
RETURN
END
CCCCCCCCCCCC THE END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC