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='' 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