home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
aosfortran
/
aosker.fr
< prev
next >
Wrap
Text File
|
1984-02-01
|
74KB
|
2,434 lines
CCCCCCCCCCCCCCCCCCCCCC KEMRIT.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
C KERMIT-AOS MAIN PROGRAM
C
C Implemented by John Lee of RCA Laboratories for Data General
C family of mini-computers running the AOS operating system.
C
C Permission is granted to any individual or institution to
C copy or use this program, except for explicitly commercial
C purpose.
C
C John Lee
C RCA Laboratories
C (609) 734-3157
C 7/5/84
C
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
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 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 CON(9)
DATA CON(1),CON(2),CON(3),CON(4),CON(5),CON(6),CON(7),CON(8),CON(9
*)/64,67,79,78,83,79,76,69,10002/
INTEGER CON4(6)
DATA CON4(1),CON4(2),CON4(3),CON4(4),CON4(5),CON4(6)/64,67,79,78,5
*2,10002/
INTEGER CON11(7)
DATA CON11(1),CON11(2),CON11(3),CON11(4),CON11(5),CON11(6),CON11(7
*)/64,67,79,78,49,49,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(12)
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/
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,64,99,111,110,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='<BEL><BEL>'
IBM=0
HOST=-1
AONE=1
BONE=1
ATWO=2
LOCALINFD=AOPEN(CON,0)
IF(.NOT.(LOCALINFD.EQ.10001))GOTO 23000
CALL CANT(CON)
23000 CONTINUE
LOCALOUTFD=AOPEN(CON,3)
IF(.NOT.(LOCALOUTFD.EQ.10001))GOTO 23002
CALL CANT(CON)
23002 CONTINUE
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-AOS Version 1.0")
CALL REMARK("Remote or Local KERMIT mode R/L ??")
STATUS=GETLIN(ALIN,LOCALINFD)
CALL UPPER(ALIN,BLIN)
IF(.NOT.(BLIN(1).EQ.82))GOTO 23004
CALL REMARK("Remote kermit now in effect")
RMTINFD=LOCALINFD
RMTOUTFD=LOCALOUTFD
GOTO 23005
23004 CONTINUE
IF(.NOT.(BLIN(1).EQ.76))GOTO 23006
HOST=0
CALL REMARK("Local kermit now in effect")
CALL REMARK("9600 or 1200 Baud (9/1) ??")
STATUS=GETLIN(ALIN,LOCALINFD)
IF(.NOT.(ALIN(1).EQ.57))GOTO 23008
SPEED=-1
RMTINFD=AOPEN(CON4,0)
IF(.NOT.(RMTINFD.EQ.10001))GOTO 23010
CALL CANT(CON4)
23010 CONTINUE
RMTOUTFD=AOPEN(CON4,3)
IF(.NOT.(RMTOUTFD.EQ.10001))GOTO 23012
CALL CANT(CON4)
23012 CONTINUE
GOTO 23009
23008 CONTINUE
SPEED=0
RMTINFD=AOPEN(CON11,0)
IF(.NOT.(RMTINFD.EQ.10001))GOTO 23014
CALL CANT(CON11)
23014 CONTINUE
RMTOUTFD=AOPEN(CON11,3)
IF(.NOT.(RMTOUTFD.EQ.10001))GOTO 23016
CALL CANT(CON11)
23016 CONTINUE
23009 CONTINUE
GOTO 23007
23006 CONTINUE
CALL REMARK ("Unknown mode, try again")
CALL RATEXIT
23007 CONTINUE
23005 CONTINUE
ISTAT=1
23018 IF(.NOT.(ISTAT.EQ.1))GOTO 23019
CALL WRSEQ(LOCALOUTFD,"KERMIT-AOS >",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 23020
TEMP=AOPEN(HELPFILE,0)
23022 IF(.NOT.((GETLIN(ALIN,TEMP).NE.10003)))GOTO 23023
CALL PUTLIN(ALIN,LOCALOUTFD)
GOTO 23022
23023 CONTINUE
CALL RATCLOSE(TEMP)
GOTO 23021
23020 CONTINUE
IF(.NOT.((FLAG2.EQ.1).OR.(FLAG3.EQ.1)))GOTO 23024
CALL REMARK("Kermit now terminated")
CALL RATEXIT
GOTO 23025
23024 CONTINUE
IF(.NOT.(FLAG4.EQ.1))GOTO 23026
CALL REMARK(" PACKET ")
CALL REMARK(" MODE IBM QUOTE SIZE EOL TTY SPEED STATE")
CALL REMARK(" ")
IF(.NOT.(HOST.EQ.-1))GOTO 23028
SLIN(1)=114
SLIN(2)=101
SLIN(3)=109
SLIN(4)=111
SLIN(5)=116
SLIN(6)=101
GOTO 23029
23028 CONTINUE
SLIN(1)=32
SLIN(2)=108
SLIN(3)=111
SLIN(4)=99
SLIN(5)=97
SLIN(6)=108
23029 CONTINUE
IF(.NOT.(IBM.EQ.-1))GOTO 23030
SLIN(8)=111
SLIN(9)=110
SLIN(10)=32
SLIN(11)=32
GOTO 23031
23030 CONTINUE
SLIN(8)=111
SLIN(9)=102
SLIN(10)=102
SLIN(11)=32
23031 CONTINUE
IF(.NOT.(HOST.EQ.-1))GOTO 23032
SLIN(33)=32
SLIN(34)=32
GOTO 23033
23032 CONTINUE
IF(.NOT.(SPEED.EQ.-1))GOTO 23034
SLIN(33)=52
SLIN(34)=32
SLIN(35)=32
SLIN(36)=57
SLIN(37)=54
SLIN(38)=48
SLIN(39)=48
SLIN(40)=32
GOTO 23035
23034 CONTINUE
SLIN(33)=49
SLIN(34)=49
SLIN(35)=32
SLIN(36)=49
SLIN(37)=50
SLIN(38)=48
SLIN(39)=48
SLIN(40)=32
23035 CONTINUE
23033 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(SLIN,LOCALOUTFD)
CALL REMARK(" ")
GOTO 23027
23026 CONTINUE
IF(.NOT.(FLAG5.EQ.1))GOTO 23036
IF(.NOT.(HOST.EQ.-1))GOTO 23038
CALL REMARK("Not supported in host kermit mode")
GOTO 23039
23038 CONTINUE
IBM=-1
23039 CONTINUE
GOTO 23037
23036 CONTINUE
IF(.NOT.(FLAG6.EQ.1))GOTO 23040
IBM=0
GOTO 23041
23040 CONTINUE
IF(.NOT.(FLAG7.EQ.1))GOTO 23042
ITEMP=0
CALL REMARK("enter filename or @filename")
STATUS=GETLIN(ALIN,LOCALINFD)
CALL REMOVE(MOREFILE)
MOREFD=AOPEN(MOREFILE,3)
IF(.NOT.(ALIN(1).NE.64))GOTO 23044
CALL PUTLIN(ALIN,MOREFD)
GOTO 23045
23044 CONTINUE
CALL SCOPY(ALIN,ATWO,DLIN,AONE)
ITEMP=AOPEN(DLIN,0)
IF(.NOT.(ITEMP.EQ.10001))GOTO 23046
CALL REMARK("Source file not found")
GOTO 23047
23046 CONTINUE
23048 IF(.NOT.(GETLIN(ALIN,ITEMP).NE.10003))GOTO 23049
CALL PUTLIN(ALIN,MOREFD)
GOTO 23048
23049 CONTINUE
CALL RATCLOSE(ITEMP)
23047 CONTINUE
23045 CONTINUE
CALL RATCLOSE(MOREFD)
IF(.NOT.(ITEMP.NE.10001))GOTO 23050
IF(.NOT.(HOST.EQ.-1))GOTO 23052
CALL WAIT(15,2,IER)
23052 CONTINUE
STATUS=SENDSW(X)
IF(.NOT.(HOST.EQ.0))GOTO 23054
CALL WRSEQ(LOCALOUTFD,BELL,2,IER)
23054 CONTINUE
IF(.NOT.(HOST.EQ.0))GOTO 23056
CALL REMARK(" ")
23056 CONTINUE
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
IF(.NOT.(FD.NE.10001))GOTO 23062
CALL RATCLOSE(FD)
23062 CONTINUE
23050 CONTINUE
GOTO 23043
23042 CONTINUE
IF(.NOT.(FLAG8.EQ.1))GOTO 23064
STATUS=RECSW(X)
IF(.NOT.(HOST.EQ.0))GOTO 23066
CALL WRSEQ(LOCALOUTFD,BELL,2,IER)
23066 CONTINUE
IF(.NOT.(HOST.EQ.0))GOTO 23068
CALL REMARK(" ")
23068 CONTINUE
IF(.NOT.((STATUS.EQ.-1).AND.(HOST.EQ.0)))GOTO 23070
CALL REMARK("COMPLETED")
23070 CONTINUE
IF(.NOT.((STATUS.NE.-1).AND.(HOST.EQ.0)))GOTO 23072
CALL REMARK("FAILED")
23072 CONTINUE
IF(.NOT.(FD.NE.10001))GOTO 23074
CALL RATCLOSE(FD)
23074 CONTINUE
GOTO 23065
23064 CONTINUE
IF(.NOT.(FLAG9.EQ.1))GOTO 23076
IF(.NOT.(HOST.EQ.-1))GOTO 23078
CALL REMARK("Connect is not supported in Host mode")
GOTO 23079
23078 CONTINUE
CALL TTYRAW
CALL CONNECT
CALL TTYCOOK
23079 CONTINUE
GOTO 23077
23076 CONTINUE
CALL REMARK("Invalid command, please type HELP")
23077 CONTINUE
23065 CONTINUE
23043 CONTINUE
23041 CONTINUE
23037 CONTINUE
23027 CONTINUE
23025 CONTINUE
23021 CONTINUE
GOTO 23018
23019 CONTINUE
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC AOPEN.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION AOPEN (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 TEMP
INTEGER STRING(40), CH
TEMP=MODE
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. 3))GOTO 23013
CALL CFILW(STRING,2,IER)
CALL OPEN(CH,STRING,0,IER)
GOTO 23014
23013 CONTINUE
IF(.NOT.(MODE .EQ. 0))GOTO 23015
CALL OPEN (CH, STRING, 1, IER)
GOTO 23016
23015 CONTINUE
IF(.NOT.(MODE .EQ. 1 .OR. MODE .EQ. 2))GOTO 23017
CALL CFILW (STRING, 2, IER)
CALL OPEN (CH, STRING, 3, IER)
23017 CONTINUE
23016 CONTINUE
23014 CONTINUE
23012 CONTINUE
IF(.NOT.(TEMP.EQ.3))GOTO 23019
TEMP=1
23019 CONTINUE
IF(.NOT.(IER .NE. 1))GOTO 23021
CH = 10001
GOTO 23022
23021 CONTINUE
CHANNEL(CH) = TEMP
23022 CONTINUE
AOPEN=(CH)
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC BUFEMP.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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.13))GOTO 23007
CALL KPUTCH(T,CH)
23007 CONTINUE
23001 I=I+1
GOTO 23000
23002 CONTINUE
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC BUFILL.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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.10))GOTO 23004
BUFFER(I)=QUOTE
I=I+1
BUFFER(I)=CTL(13)
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.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE CANT(BUF)
INTEGER BUF(132)
CALL PUTLIN(BUF, 2)
CALL REMARK(": can't open.")
CALL RATEXIT
END
CCCCCCCCCCCCCCCCCCCCCC CHKIO.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE CHKIO (FD, IER)
INTEGER FD, IER
IF(.NOT.(IER .EQ. 1 .OR. IER .EQ. 27))GOTO 23000
RETURN
23000 CONTINUE
WRITE (2, 1) IER, FD
1 FORMAT(" *** error code ", I6, " from channel ", I6)
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC COMPILEALL.CLI CCCCCCCCCCCCCCCCCCCCCCCCCCC
WRITE Compiling all KERMIT subroutines need to install KERMIT-AOS
F5 AOPEN
F5 BUFEMP
F5 BUFILL
F5 CANT
F5 CONNECT
F5 CTL
F5 FINDLN
F5 IBMGETLIN
F5 KERMIT
F5 KGETCH
F5 KGETLIN
F5 KPICK
F5 KPUTCH
F5 RDATA
F5 RECSW
F5 RFILE
F5 RINIT
F5 RPACK
F5 RPAR
F5 SBREAK
F5 SDATA
F5 SENDSW
F5 SEOF
F5 SFILE
F5 SINIT
F5 SPACK
F5 SPACK1
F5 SPAR
F5 TOCHAR
F5 TTYCOOK
F5 TTYRAW
F5 UNCHAR
F5 UNHUNG
F5 UPPER
F5 VERIFY
WRITE Compiling all RATFOR library subroutine needed for KERMIT-AOS
F5 CHKIO
F5 FLUSH
F5 GETCH
F5 GETLIN
F5 ITOC
F5 LENGTH
F5 PACK
F5 PUTC
F5 PUTCH
F5 PUTDEC
F5 PUTINT
F5 PUTLIN
F5 PUTSTR
F5 RATCLOSE
F5 RATEXIT
F5 REMARK
F5 REMOVE
F5 SCOPY
F5 SSCOPY
F5 STDIO
F5 STDOPEN
F5 STDSETUP
WRITE All subroutines needed to installed KERMIT-AOS have veen compiled
CCCCCCCCCCCCCCCCCCCCCC CONNECT.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
TASK KPICK,ID=3,PRI=1
CALL REMARK(" typing CNTR-] causes return to KERMIT-AOS")
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 TIDK(3,IER)
CALL WAIT(1,2,IER)
CALL REMARK("returning to Kermit-AOS")
CALL WRSEQ(RMTOUTFD,CQ,1,IER)
RETURN
23002 CONTINUE
IF(.NOT.(ICHAR.EQ.ECHAR))GOTO 23004
CALL TIDK(3,IER)
CALL WAIT(1,2,IER)
CALL REMARK("returning to Kermit-AOS")
CALL WRSEQ(RMTOUTFD,CQ,1,IER)
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
CCCCCCCCCCCCCCCCCCCCCC CTL.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION CTL(CH)
INTEGER CH
CTL=IXOR(CH,100K)
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC FINDLN.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC FLUSH.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC HELP_KERMIT CCCCCCCCCCCCCCCCCCCCCCCCCCC
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, program
- 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 packet.
STATUS - Displays the current values of various setting.
CCCCCCCCCCCCCCCCCCCCCC IBMGETLIN.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
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.IDC1))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
CCCCCCCCCCCCCCCCCCCCCC ITOC.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC GETCH.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
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
CCCCCCCCCCCCCCCCCCCCCC GETLIN.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC KGETCH.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION KGETCH(T,CHAN)
INTEGER T,CHAN,X,IER
CALL RDSEQ(CHAN,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
CCCCCCCCCCCCCCCCCCCCCC KGETLIN.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION KGETLIN(ALIN,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 ALIN(132)
INTEGER BLIN(132)
INTEGER COUNT,IER
CALL RDLIN(CH,BLIN,COUNT,IER)
IF(.NOT.(IER.NE.1))GOTO 23000
KGETLIN=10001
GOTO 23001
23000 CONTINUE
KGETLIN=1
23001 CONTINUE
I=1
23002 IF(.NOT.(I.LE.COUNT))GOTO 23004
ALIN(I)=BYTE(BLIN,I) .AND. 177K
23003 I=I+1
GOTO 23002
23004 CONTINUE
IF(.NOT.(ALIN(COUNT).EQ.127))GOTO 23005
ALIN(COUNT)=13
23005 CONTINUE
ALIN(COUNT+1)=10002
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC KPICK.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
IF(.NOT.(IBM.EQ.0))GOTO 23000
23002 IF(.NOT.(STATUS.EQ.1))GOTO 23003
CALL RDSEQ(RMTINFD,ALIN,1,IER)
CALL WRSEQ(LOCALOUTFD,ALIN,1,IER)
GOTO 23002
23003 CONTINUE
GOTO 23001
23000 CONTINUE
23004 IF(.NOT.(STATUS.EQ.1))GOTO 23005
CALL RDSEQ(RMTINFD,IBYTE,1,IER)
CALL WRSEQ(LOCALOUTFD,IBYTE,1,IER)
GOTO 23004
23005 CONTINUE
23001 CONTINUE
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC KPUTCH.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC LINKALL.CLI CCCCCCCCCCCCCCCCCCCCCCCCCCC
F5LD/TASKS=7/QCALLS KERMIT &
AOPEN &
BUFEMP BUFILL &
CANT CHKIO CONNECT CTL &
FINDLN FLUSH &
IBMGETLIN ITOC &
GETCH GETLIN &
KGETCH KGETLIN KPICK KPUTCH &
LENGTH &
PACK PUTC PUTCH PUTDEC PUTINT PUTLIN PUTSTR &
RATEXIT RATCLOSE RDATA RECSW REMARK REMOVE RFILE RINIT RPACK RPAR &
SBREAK SCOPY SDATA SENDSW SEOF SFILE SINIT SPACK SPACK1 SPAR SSCOPY STDIO &
STDOPEN STDSETUP &
TOCHAR TTYCOOK TTYRAW &
UNCHAR UNHUNG UPPER &
VERIFY
CCCCCCCCCCCCCCCCCCCCCC LENGTH.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC PACK.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC PUTC.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE PUTC(C)
INTEGER C
CALL PUTCH(C, 1)
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC PUTCH.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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)) = 10
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
CCCCCCCCCCCCCCCCCCCCCC PUTDEC.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE PUTDEC(N, W)
INTEGER N, W
CALL PUTINT(N, W, 1)
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC PUTINT.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC PUTLIN.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC PUTSTR.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC RATEXIT.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC RATCLOSE.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC RDATA.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
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
CCCCCCCCCCCCCCCCCCCCCC RECSW.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CALL TTYRAW
IF(.NOT.(HOST.EQ.0))GOTO 23000
TASK UNHUNG, ID=2, PRI=255
23000 CONTINUE
23002 IF(.NOT.(STATUS.EQ.1))GOTO 23003
IF(.NOT.(STATE.EQ.68))GOTO 23004
STATE=RDATA(X)
GOTO 23005
23004 CONTINUE
IF(.NOT.(STATE.EQ.70))GOTO 23006
STATE=RFILE(X)
GOTO 23007
23006 CONTINUE
IF(.NOT.(STATE.EQ.82))GOTO 23008
STATE=RINIT(X)
GOTO 23009
23008 CONTINUE
IF(.NOT.(STATE.EQ.67))GOTO 23010
RECSW=-1
IF(.NOT.(HOST.EQ.0))GOTO 23012
CALL TIDK(2,IER)
CALL WAIT(1,2,IER)
23012 CONTINUE
CALL TTYCOOK
RETURN
23010 CONTINUE
IF(.NOT.(STATE.EQ.65))GOTO 23014
RECSW=0
IF(.NOT.(HOST.EQ.0))GOTO 23016
CALL TIDK(2,IER)
CALL WAIT(1,2,IER)
23016 CONTINUE
CALL TTYCOOK
RETURN
23014 CONTINUE
23011 CONTINUE
23009 CONTINUE
23007 CONTINUE
23005 CONTINUE
GOTO 23002
23003 CONTINUE
CALL TTYCOOK
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC REMARK.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC REMOVE.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE REMOVE(NAME)
INTEGER NAME(50)
INTEGER PNAME(50)
INTEGER PACK, IER
IER = PACK (NAME, PNAME, 50)
CALL DFILW (PNAME, IER)
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC RFILE.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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)=10
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)
CALL PUTCH(10,LOCALOUTFD)
CALL REMARK(" Packet # ")
23018 CONTINUE
FD=AOPEN(PACKET,1)
IF(.NOT.(FD.EQ.10001))GOTO 23020
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
CCCCCCCCCCCCCCCCCCCCCC RINIT.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC RPACK.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
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=GETLIN(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
CCCCCCCCCCCCCCCCCCCCCC RPAR.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC SBREAK.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC SCOPY.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC SDATA.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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 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(TNUM,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
CCCCCCCCCCCCCCCCCCCCCC SENDSW.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CALL TTYRAW
IF(.NOT.(HOST.EQ.0))GOTO 23000
TASK UNHUNG,ID=2,PRI=255
23000 CONTINUE
23002 IF(.NOT.(STATUS.EQ.1))GOTO 23003
IF(.NOT.(STATE.EQ.68))GOTO 23004
STATE=SDATA(X)
GOTO 23005
23004 CONTINUE
IF(.NOT.(STATE.EQ.70))GOTO 23006
STATE=SFILE(X)
GOTO 23007
23006 CONTINUE
IF(.NOT.(STATE.EQ.90))GOTO 23008
STATE=SEOF(X)
GOTO 23009
23008 CONTINUE
IF(.NOT.(STATE.EQ.83))GOTO 23010
STATE=SINIT(X)
GOTO 23011
23010 CONTINUE
IF(.NOT.(STATE.EQ.66))GOTO 23012
STATE=SBREAK(X)
GOTO 23013
23012 CONTINUE
IF(.NOT.(STATE.EQ.67))GOTO 23014
SENDSW=-1
IF(.NOT.(HOST.EQ.0))GOTO 23016
CALL TIDK(2,IER)
CALL WAIT(1,2,IER)
23016 CONTINUE
CALL TTYCOOK
RETURN
23014 CONTINUE
IF(.NOT.(STATE.EQ.65))GOTO 23018
SENDSW=0
IF(.NOT.(HOST.EQ.0))GOTO 23020
CALL TIDK(2,IER)
CALL WAIT(1,2,IER)
23020 CONTINUE
CALL TTYCOOK
RETURN
23018 CONTINUE
STATUS=0
SENDSW=0
IF(.NOT.(HOST.EQ.0))GOTO 23022
CALL TIDK(2,IER)
CALL WAIT(1,2,IER)
23022 CONTINUE
23019 CONTINUE
23015 CONTINUE
23013 CONTINUE
23011 CONTINUE
23009 CONTINUE
23007 CONTINUE
23005 CONTINUE
GOTO 23002
23003 CONTINUE
CALL TTYCOOK
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC SEOF.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
FD=AOPEN(FILNAM,0)
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=66
CALL RATCLOSE(MOREFD)
RETURN
23016 CONTINUE
CALL SCOPY(ALIN,AONE,FILNAM,BONE)
FD=AOPEN(FILANM,0)
IF(.NOT.(FD.NE.10001))GOTO 23018
TEMP=0
23018 CONTINUE
23017 CONTINUE
GOTO 23014
23015 CONTINUE
SEOF=70
RETURN
23012 CONTINUE
SEOF=70
RETURN
23013 CONTINUE
23011 CONTINUE
GOTO 23007
23006 CONTINUE
IF(.NOT.(STATUS.EQ.0))GOTO 23020
SEOF=STATE
RETURN
23020 CONTINUE
SEOF=65
23021 CONTINUE
23007 CONTINUE
23003 CONTINUE
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC SFILE.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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)
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
CCCCCCCCCCCCCCCCCCCCCC SINIT.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
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/
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
RETURN
23008 CONTINUE
CALL RPAR(RECPKT)
IF(.NOT.(EOL.EQ.0))GOTO 23010
EOL=10
23010 CONTINUE
IF(.NOT.(QUOTE.EQ.0))GOTO 23012
QUOTE=35
23012 CONTINUE
NUMTRY=0
N=MOD((N+1),64)
MOREFD=AOPEN(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)
FD=AOPEN(FILNAM,0)
IF(.NOT.(FD.NE.10001))GOTO 23018
TEMP=0
23018 CONTINUE
23017 CONTINUE
GOTO 23014
23015 CONTINUE
SINIT=70
RETURN
23006 CONTINUE
IF(.NOT.(STATUS.EQ.0))GOTO 23020
SINIT=STATE
RETURN
23020 CONTINUE
SINIT=65
23021 CONTINUE
23007 CONTINUE
23003 CONTINUE
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC SPACK.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC SPACK1.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE SPACK1(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
CCCCCCCCCCCCCCCCCCCCCC SPAR.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC SSCOPY.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC STDIO.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC STDOPEN.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC STDSETUP.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC TOCHAR.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION TOCHAR(CH)
INTEGER CH
TOCHAR=CH+32
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC TTYCOOK.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE TTYCOOK
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 IER
INTEGER XCHAR(3)
IF(.NOT.(HOST.EQ.-1))GOTO 23000
CALL QGCHR(000000K,"@console",XCHAR,IER)
CALL ISET(XCHAR(1),0)
CALL ISET(XCHAR(1),1)
CALL ICLR(XCHAR(2),15)
CALL QSCHR(000000K,"@console",XCHAR,IER)
GOTO 23001
23000 CONTINUE
IF(.NOT.(SPEED.EQ.0))GOTO 23002
CALL QGCHR(000000K,"@con11",XCHAR,IER)
CALL ISET(XCHAR(1),0)
CALL ISET(XCHAR(1),1)
CALL ICLR(XCHAR(2),15)
CALL QSCHR(000000K,"@con11",XCHAR,IER)
GOTO 23003
23002 CONTINUE
CALL QGCHR(000000K,"@con4",XCHAR,IER)
CALL ISET(XCHAR(1),0)
CALL ISET(XCHAR(1),1)
CALL ICLR(XCHAR(2),15)
CALL QSCHR(000000K,"@con4",XCHAR,IER)
23003 CONTINUE
23001 CONTINUE
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC TTYRAW.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE TTYRAW
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 IER
INTEGER XCHAR(3)
IF(.NOT.(HOST.EQ.-1))GOTO 23000
CALL QGCHR(000000K,"@console",XCHAR,IER)
CALL ICLR(XCHAR(1),0)
CALL ICLR(XCHAR(1),1)
CALL ISET(XCHAR(2),15)
CALL QSCHR(000000K,"@console",XCHAR,IER)
GOTO 23001
23000 CONTINUE
IF(.NOT.(SPEED.EQ.0))GOTO 23002
CALL QGCHR(000000K,"@con11",XCHAR,IER)
CALL ICLR(XCHAR(1),0)
CALL ICLR(XCHAR(1),1)
CALL ISET(XCHAR(2),15)
CALL QSCHR(000000K,"@con11",XCHAR,IER)
GOTO 23003
23002 CONTINUE
CALL QGCHR(000000K,"@con4",XCHAR,IER)
CALL ICLR(XCHAR(1),0)
CALL ICLR(XCHAR(1),1)
CALL ISET(XCHAR(2),15)
CALL QSCHR(000000K,"@con4",XCHAR,IER)
23003 CONTINUE
23001 CONTINUE
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC UNCHAR.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER FUNCTION UNCHAR(CH)
INTEGER CH
UNCHAR=CH-32
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC UNHUNG.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE UNHUNG
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 ALIN(132)
INTEGER TNUM,STATUS,GETLIN
23000 IF(.NOT.((GETLIN(ALIN,LOCALINFD).NE.10003)))GOTO 23001
IF(.NOT.((ALIN(1).EQ.81).AND.(ALIN(2).EQ.117)))GOTO 23002
CALL RATEXIT
23002 CONTINUE
CALL REMARK("Sending out a NAK for retry purpose")
TNUM=N
CALL SPACK1(78,TNUM,0,0)
GOTO 23000
23001 CONTINUE
RETURN
END
CCCCCCCCCCCCCCCCCCCCCC UPPER.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
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
CCCCCCCCCCCCCCCCCCCCCC VERIFY.FR CCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE VERIFY(TFILE)
INTEGER INFILE(132)
INTEGER OUTFILE(132)
INTEGER TFILE(132)
INTEGER AONE,BONE,TEMP
AONE=1
BONE=1
TEMP=1
CALL UPPER(TFILE,INFILE)
23000 IF(.NOT.((INFILE(TEMP).NE.10).AND.(INFILE(TEMP).NE.10002)))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,TFILE,BONE)
RETURN
END
CCCCCCCCC THE END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC