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