$BATCH $PROG PEKERMIT IMPLICIT INTEGER (A-Z) INTEGER COMNDS(15) C LOGICAL HLPFLG C INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65) COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH C DATA COMNDS/'8BIT','DIRE','EXIT','HELP','LINE','MODE','NPAD', +'PACK','PAD-','QUIT','RECE','SEND','SOH ','STAT','TYPE'/ C SPACE=Y'20202020' BKSPC=Y'08080808' BELL=Y'07070707' DELE=8 CTLX=24 C DASH=45 ; - STAR=42 ; * PERIOD=46 ; . BSLSH=92 ; \ COLON=58 ; : C SOH=15 MYEOL=13 YREOL=MYEOL MYCTL=35 YRCTL=MYCTL MYFG0=38 QUOT8B=0 MYMAX=50 YRMAX=94 MYTIM=8 YRTIM=MYTIM MYNPAD=0 YRNPAD=MYNPAD MYPAD=0 YRPAD=MYPAD MYRPT=78 ; USE "~"(126), FOR RPTS RECORD=80 MODE=0 ; DEFAULT TO ASCII MODE C SI=83 ; "S" FN=70 ; "F" DA=68 ; "D" ER=69 ; "E" BR=66 ; "B" EF=90 ; "Z" ACK=89 ; "Y" NAK=78 ; "N" SEQNCE=32 C CLU=2 ; INITIAL MODE IS BATCH LLU=15 ; 15 NORMALLY UNASSIGNED FILE=2 DIR=3 PRMPT=14 C HELP=63 ; => ? INIT=0 C >> START WITH A [CLS] << REPORT=CONMSG(1) ; CLS C >> [PEKERMIT] 1 REPORT=CONMSG(2) ; PROMPT POINTR=0 NTODO=0 VALUE=0 FLAG=0 2 IC=GETCH(0) IF(INIT.EQ.2) INIT=0 IF(IC.EQ.SOH.AND.INIT.EQ.0) INIT=1 IF(IC.EQ.MYEOL.AND.INIT.EQ.1) INIT=2 IF(INIT.NE.0) GO TO 2 ; IGNORE EXCESS PACKETS IF(IC.EQ.MYPAD) GO TO 2 ; IGNORE INADVERTENT PADS IF(IC.NE.DELE.AND.IC.NE.CTLX) GO TO 3 IF(IC.EQ.CTLX) CALL SYSIO(PBLK,41,LLU,BKSPC,1,0,0) CALL SYSIO(PBLK,41,LLU,SPACE,1,0,0) ; OVERWRITE CHAR CALL SYSIO(PBLK,41,LLU,BKSPC,1,0,0) ; BACKSPACE IF(IC.EQ.CTLX) GO TO 1 ; CTRL-X POINTR=POINTR-1 IF(POINTR.GE.0) CALL ILBYTE(IC,RBUF,POINTR) IF(IC.GE.48.AND.IC.LE.57) VALUE=VALUE/10 IF(FLAG.GT.POINTR) FLAG=POINTR IF(POINTR.GT.0) GO TO 2 CALL SYSIO(PBLK,41,LLU,BELL,1,0,0) GO TO 1 3 IF(IC.GE.97.AND.IC.LE.122) IC=IC-32 IF(IC.EQ.13.OR.IC.EQ.HELP) GO TO 4 ; HELP CHAR DEF = ? IF(IC.GE.48.AND.IC.LE.57.AND.POINTR.GT.0) VALUE=10*VALUE+IC-48 CALL ISBYTE(IC,RBUF,POINTR) IF(IC.GE.65.AND.NTODO.EQ.POINTR) NTODO=NTODO+1 IF(IC.LT.65.AND.FLAG.LE.0.AND.POINTR.NE.0) FLAG=POINTR+1 C IF(IC.EQ.56.AND.POINTR.EQ.0) NTODO=NTODO+1 C POINTR=POINTR+1 GO TO 2 C C >> COMMAND PARSER << C 4 I=-1 ; INDICATES FULL-HELP IF(POINTR.LE.0) GO TO 301 IF(NTODO.GT.4) NTODO=4 I=0 J=0 K=0 DO 6 M=1,15 DO 5 L=1,NTODO CALL ILBYTE(L1,RBUF,L-1) CALL ILBYTE(L2,COMNDS(M),L-1) IF(L1.NE.L2) GO TO 6 5 CONTINUE J=M IF(K.EQ.0) K=J IF(J.EQ.M) CALL BSET(I,M-1) IF(J.EQ.K.AND.K.EQ.4) I=-1 6 CONTINUE IF(J.EQ.K.AND.K.EQ.0) I=-1 IF(K.EQ.J.AND.K.NE.0.AND.IC.NE.HELP) GO TO 8 7 REPORT=CONMSG(1) ; CLS IF(IC.EQ.HELP) GO TO 9 REPORT=CONMSG(3) ; UNKNOWN COMMAND IF(POINTR.GT.0) CALL SYSIO(PBLK,41,LLU,RBUF,POINTR,0,0) IF(POINTR.LE.0) CALL SYSIO(PBLK,40,LLU,SPACE,1,0,0) GO TO 9 8 CONTINUE GO TO (1400,100,200,300,1000,400,500,600,700,800,900,1100, +1500,1200,1300),K C C >> HELP FUNCTION - LEVEL 1 << C 9 REPORT=CONMSG(5) ; HELP SCREEN BANNER DO 10 N=1,15 IF(COMNDS(N).LE.' ') GO TO 10 HLPFLG=BTEST(I,N-1) IF(.NOT.HLPFLG) GO TO 10 REPORT=CONMSG(6) ; (NEW LINE) IER=N+25 REPORT=CONMSG(IER) ; HELP LINE #N+1 10 CONTINUE REPORT=CONMSG(6) ; (NEW LINE) GO TO 1 C C >> DIRECTORY << C 100 IF(FLAG.LE.0) RBUF(1)='*.* ' CALL EXPDFD(FLAG) REWIND DIR REPORT=CONMSG(6) ; (NEW LINE) CALL SYSIO(PBLK,72,DIR,RBUF(5),20,0,0) CALL SYSIO(PBLK,72,DIR,RBUF(5),20,0,0) CALL SYSIO(PBLK,40,LLU,RBUF(5),20,0,0) CALL SYSIO(PBLK,40,LLU,SPACE,4,0,0) REPORT=CONMSG(6) COUNT=3 101 CALL SYSIO(PBLK,72,DIR,RBUF(5),20,0,0) IER=IAND(PBLK(1),Y'FFFF') IF(IER.NE.0) GO TO 1 IER=COMPFD(RBUF,RBUF(5),1) IF(IER.EQ.0) GO TO 101 C CALL ISBYTE(32,RBUF(5),13) CALL ILBYTE(IC,RBUF(5),14) IF(IC.NE.35) CALL ISBYTE(32,RBUF(5),14) ; CLEAR OUT GARBAGE C CALL SYSIO(PBLK,40,LLU,RBUF(5),15,0,0) COUNT=COUNT+1 IF(COUNT.LT.23) GO TO 101 COUNT=0 REPORT=CONMSG(21) ; CONTINUE PROMPT IC=GETCH(0) IF(IC.EQ.81.OR.IC.EQ.113) GO TO 1 REPORT=CONMSG(1) ; CLS GO TO 101 C C >> EXIT << C 200 REPORT=CONMSG(1) ; CLS REPORT=CONMSG(4) ; LOGOFF... DO 201 N=1,15 201 CALL CLOSE(N-1,IER) CALL EXIT C C >> HELP << 300 I=-1 301 REPORT=CONMSG(1) ; CLS GO TO 9 C C >> MODE << C 400 IC=MODE IF(FLAG.GT.0) CALL ILBYTE(IC,RBUF,FLAG) IF(IC.EQ.65.OR.IC.EQ.66) IC=66-IC MODE=1-IC REPORT=CONMSG(6) REPORT=CONMSG(18) RBUF(1)='ASCI' RBUF(2)='I ' IF(MODE.LE.0) GO TO 401 RBUF(1)='BINA' RBUF(2)='RY ' 401 CALL SYSIO(PBLK,40,LLU,RBUF,7,0,0) GO TO 1 C C >> NPADS << C 500 IF(VALUE.LT.0.OR.VALUE.GT.64) GO TO 301 MYNPAD=VALUE REPORT=CONMSG(6) REPORT=CONMSG(13) CALL SYSIO(PBLK,40,LLU,NCOD(MYNPAD),4,0,0) GO TO 1 C C >> PACK << C 600 IF(VALUE.LT.20.OR.VALUE.GT.94) GO TO 301 ; ILLEGAL MYMAX=VALUE YRMAX=MYMAX REPORT=CONMSG(6) REPORT=CONMSG(12) CALL SYSIO(PBLK,40,LLU,NCOD(MYMAX),4,0,0) GO TO 1 C C >> PADDING << C 700 IF((VALUE.LT.0.OR.VALUE.GT.32).AND.VALUE.NE.127) GO TO 301 MYPAD=VALUE YRPAD=MYPAD REPORT=CONMSG(6) REPORT=CONMSG(14) CALL SYSIO(PBLK,40,LLU,NCOD(MYPAD),4,0,0) GO TO 1 C C >> QUIT << C 800 GO TO 200 C C >> RECEIV << C 900 CALL RECEIV GO TO 1 C C >> RECORD << C 1000 IF(VALUE.LT.1.OR.VALUE.GT.256) GO TO 301 RECORD=VALUE REPORT=CONMSG(6) REPORT=CONMSG(17) CALL SYSIO(PBLK,40,LLU,NCOD(RECORD),4,0,0) GO TO 1 C C >> SEND << C 1100 IF(FLAG.LE.0) GO TO 7 CALL SEND(FLAG) GO TO 1 C C >> STATUS << C 1200 CALL STATUS GO TO 1 C C >> TYPE << C 1300 IF(FLAG.LE.0) GO TO 7 DO 1301 N=1,20 CALL ILBYTE(IC,RBUF,FLAG) IF(IC.LT.32.OR.IC.GT.125) FLAG=N-1 IF(FLAG.LT.N) IC=32 FLAG=FLAG+1 1301 CALL ISBYTE(IC,RBUF,N-1) CALL CLOSE(FILE,IER) CALL OPENW(FILE,RBUF,4,0,0,IER) CALL SYSIO(PBLK,40,LLU,SPACE,4,0,0) ; NEW LINE COUNT=0 IF(IER.LE.0) GO TO 1302 REPORT=CONMSG(20) ; FILE ACCESS ERROR CALL SYSIO(PBLK,41,LLU,RBUF,20,0,0) REPORT=CONMSG(6) GO TO 1 1302 CALL SYSIO(PBLK,72,FILE,RBUF,126,0,0) IER=IAND(PBLK(1),Y'FFFF') IF(IER.NE.0) GO TO 1303 LEN=PBLK(5) CALL SYSIO(PBLK,40,LLU,RBUF,LEN,0,0) COUNT=COUNT+1 IF(COUNT.LT.23) GO TO 1302 COUNT=0 REPORT=CONMSG(21) ; CONTINUE PROMPT IC=GETCH(0) IF(IC.EQ.81.OR.IC.EQ.113) GO TO 1303 CALL SYSIO(PBLK,40,LLU,SPACE,4,0,0) GO TO 1302 1303 CALL CLOSE(FILE,IER) GO TO 1 C C >> 8BIT << C 1400 QUOT8B=1-QUOT8B ; TOGGLE QUOT8B IF(VALUE.EQ.1) QUOT8B=VALUE IF(FLAG.LE.0) GO TO 1401 CALL ILBYTE(IC,RBUF,FLAG+1) IF(IC.EQ.70.OR.IC.EQ.79) QUOT8B=0 ; "OFF" OR "NO" IF(IC.EQ.69.OR.IC.EQ.78) QUOT8B=1 ; "ON" OR "YES' 1401 REPORT=CONMSG(6) REPORT=CONMSG(16) RBUF(1)='OFF ' IF(QUOT8B.EQ.1) RBUF(1)=MYFG0 CALL SYSIO(PBLK,40,LLU,RBUF,4,0,0) GO TO 1 C C >> SOH << C 1500 IF((VALUE.LT.1.OR.VALUE.GT.31).AND.VALUE.NE.127) GO TO 301 SOH=VALUE REPORT=CONMSG(6) REPORT=CONMSG(10) CALL SYSIO(PBLK,40,LLU,NCOD(SOH),4,0,0) GO TO 1 END $PROG CKSUM C C INTEGER FUNCTION CKSUM(BUFF) IMPLICIT INTEGER (A-Z) INTEGER BUFF(1) COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT CALL ILBYTE(LEN,BUFF,1) LEN=LEN-32 CKSUM=0 DO 1 N=1,LEN CALL ILBYTE(IC,BUFF,N) 1 CKSUM=CKSUM+IC CKSUM=IAND((CKSUM+IAND(CKSUM,Y'C0')/Y'40'),Y'3F')+32 RETURN END $PROG COMPFD C C INTEGER FUNCTION COMPFD(BUFF1,BUFF2,INPTR) IMPLICIT INTEGER(A-Z) INTEGER BUFF1(1),BUFF2(1),POINTR COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH C C >> COMPARES 12 BYTES IN BUFF1, BEGINNING WITH BYTE #0, C WITH 12 BYTES IN BUFF2, BEGINNING WITH BYTE #POINTR. C IF ANY BUFF1 BYTE WHICH IS NOT BACKSLASH OR PERIOD C DOES NOT MATCH THE COMPARABLE BUFF2 BYTE, RESULT=0 C OTHERWISE, RESULT=1. C C ON RESULT=1, BUFF2 WILL HOLD PACKED FD, STARTING AT BYTE #1 C POINTR=INPTR COMPFD=0 DO 1 N=1,12 CALL ILBYTE(IC,BUFF1,N-1) CALL ILBYTE(JC,BUFF2,N) CALL ISBYTE(32,BUFF2,N) IF(IC.NE.JC.AND.JC.NE.PERIOD.AND.IC.NE.BSLSH) RETURN IF(JC.LE.32) GO TO 1 CALL ISBYTE(JC,BUFF2,POINTR) POINTR=POINTR+1 1 CONTINUE COMPFD=1 RETURN END $PROG CONMSG C C INTEGER FUNCTION CONMSG(NDX) IMPLICIT INTEGER(A-Z) INTEGER MBUF(20) C C >> ALWAYS WRITES TO LLU IN IMAGE MODE << C >> ERROR(S) RETURNED IN PBLK(1) USING STD SYSIO DEFINITIONS << C INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65) COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE CONMSG=-1 IF(NDX.LE.0) RETURN N=NDX-1 CALL SYSIO(PBLK,77,PRMPT,MBUF,80,N,0) CONMSG=IAND(PBLK(1),Y'FFFF') NBYTS=MBUF(1) IF(NBYTS.GT.80.AND.CONMSG.EQ.0) CONMSG=NBYTS IF(CONMSG.NE.0) RETURN IF(NBYTS.GT.0) CALL SYSIO(PBLK,41,LLU,MBUF(2),NBYTS,0,0) RETURN END $PROG CTL C C INTEGER FUNCTION CTL(CH) C C C >> TOGGLE BIT 1 OF THE LOW-ORDER BYTE OF CH (INT*4) C >> (USED TO FORCE KERMIT DATA BYTES TO BE PRINTABLE) C INTEGER CH C CTL=IEOR(CH,64) ; FLIP BIT 1, BYTE 3 RETURN END $PROG EXPDFD SUBROUTINE EXPDFD(START) C C IMPLICIT INTEGER (A-Z) INTEGER START INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65) COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH INPTR=START OUTPTR=0 1 CALL ILBYTE(IC,RBUF,INPTR) INPTR=INPTR+1 IF(IC.NE.COLON) GO TO 2 OUTPTR=0 2 IF(IC.NE.STAR.AND.IC.NE.DASH.AND.IC.NE.PERIOD.AND.IC.GT.32.AND. +IC.LT.126) GO TO 4 JC=BSLSH IF(IC.EQ.PERIOD) JC=32 3 IF(OUTPTR.GE.9) JC=BSLSH IF(IC.EQ.PERIOD.AND.OUTPTR.GE.9) GO TO 5 CALL ISBYTE(JC,RBUF,OUTPTR+28) OUTPTR=OUTPTR+1 IF(OUTPTR.NE.9.AND.OUTPTR.LT.12) GO TO 3 IF(OUTPTR.LT.12) GO TO 1 GO TO 5 4 CALL ISBYTE(IC,RBUF,OUTPTR+28) OUTPTR=OUTPTR+1 5 IF(OUTPTR.LT.12.AND.IC.GT.32.AND.IC.LT.126) GO TO 1 DO 6 N=1,24 IC=32 IF(N.LE.12) CALL ILBYTE(IC,RBUF,N+27) 6 CALL ISBYTE(IC,RBUF,N-1) RETURN END $PROG FLIPB0 C C INTEGER FUNCTION FLIPB0(CH) C C C >> TOGGLE BIT 0 OF THE LOW-ORDER BYTE OF CH (INT*4) C >> (FOR USE IN 7-BIT TRANSMISSION) C INTEGER CH C FLIPB0=IEOR(CH,128) ; FLIP BIT 0, BYTE 3 RETURN END $PROG GETCH C C INTEGER FUNCTION GETCH(DUMMY) IMPLICIT INTEGER (A-Z) INTEGER GBUF(20) INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65) COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH C C >> EXPECTS CLU TO BE 0 IF SINGLE CHARACTER I/O TO BE DONE << C >> - OTHERWISE DOES FULL-LINE I/O AND PASSES IT TO CALLER<< C >> ONE BYTE PER CALL. ON I/O ERROR WITH CLU.NE.0, << C >> CLU IS RESET TO 0, LLU TO 1, AND I/0 CONTINUES. << C DATA POINTR,NBYTS/0,0/ IF(POINTR.LT.NBYTS) GO TO 2 1 NBYTS=1 IF(CLU.NE.0) NBYTS=80 CALL SYSIO(PBLK,73,CLU,GBUF,NBYTS,0,0) POINTR=0 IER=IAND(PBLK(1),Y'FFFF') IF(IER.EQ.0) GO TO 2 CALL CLOSE(FILE,IER) CLU=0 LLU=1 YREOL=MYEOL YRCTL=MYCTL YRFG0=MYFG0 YRMAX=94 YRTIM=MYTIM YRPAD=MYPAD CALL WAIT(100,1,IER) REPORT=CONMSG(1) ; CLS CALL STATUS REPORT=CONMSG(2) ; PROMPT GO TO 1 2 CALL ILBYTE(GETCH,GBUF,POINTR) POINTR=POINTR+1 IF(GETCH.EQ.BSLSH.AND.CLU.NE.0) GETCH=13 ; END THE RECORD! IF(GETCH.EQ.13) NBYTS=POINTR RETURN END $PROG NCOD C C INTEGER FUNCTION NCOD(IVAL) NCOD=' ' IDIV=1000 I=IVAL M=1 DO 1 N=1,4 J=I/IDIV I=I-IDIV*J IDIV=IDIV/10 IF(J.GE.M.AND.J.LE.9) CALL ISBYTE(J+48,NCOD,N-1) 1 IF(J.GE.1.AND.J.LE.57) M=0 IF(NCOD.LE.' ') CALL ISBYTE(48,NCOD,3) RETURN END $PROG OPNFIL C C SUBROUTINE OPNFIL(IER) C C >> READS FILE NAME FROM A PACKET STARTING AT BYTE 0 C IN SBUF: IF FNAME EXISTS, DELETES FILE. C ALLOCATES FNAME,IN,RECORD C ASSIGNS TO C UPDATES IF NECESSARY. C IMPLICIT INTEGER(A-Z) INTEGER NAME(6) INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65) COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH POINTR=4 CALL ILBYTE(LEN,SBUF,1) C LEN=LEN-32 DO 1 N=1,24 CALL ISBYTE(32,NAME,N-1) IF(POINTR.GT.LEN) GO TO 1 CALL ILBYTE(IC,SBUF,POINTR) CALL ISBYTE(IC,NAME,N-1) POINTR=POINTR+1 1 CONTINUE CALL CLOSE(FILE,IER) CALL DFILW(NAME,0,0,JER) CALL CFILW(NAME,2,RECORD,1,1,0,0,IER) CALL OPENW(FILE,NAME,7,0,0,IER) IF(JER.EQ.0.OR.IER.NE.0) RETURN C >> FILE DIDN'T PREVIOUSLY EXIST << POINTR=12 DO 2 N=1,24 CALL ILBYTE(IC,NAME,24-N) CALL ISBYTE(32,NAME,24-N) IF(IC.LE.32) GO TO 2 CALL ISBYTE(IC,NAME,POINTR) IF(IC.EQ.PERIOD) POINTR=25-N POINTR=POINTR-1 2 CONTINUE CALL ISBYTE(35,NAME,14) CALL SYSIO(PBLK,132,DIR,0,0,0,0) CALL SYSIO(PBLK,40,DIR,NAME,15,0,0) RETURN END $PROG RECEIV C C SUBROUTINE RECEIV IMPLICIT INTEGER(A-Z) INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65) COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT C C >> LU 2 RESERVED FOR FILE ACCESS C C >> PACKET TYPES; C C SI-NIT --- "S" C FN-AME --- "F" C DA-TA --- "D" C ER-ROR --- "E" C BR-EAK --- "B" C EF-ILE --- "Z" C C RETRY=5 ; 5 TRIES ONLY REPORT=CONMSG(7) ; RETURN TO CALLER C C PAKTYP=ER PARM='-000' POINTR=0 PASS=0 1 CALL SYSIO(PBLK,73,CLU,RBUF,80,0,Y'18000000') IER=IAND(PBLK(1),Y'FFFF') IF(IER.NE.0) GO TO 10 C C >> OKAY, WE HAVE DATA SEE HOW MUCH.. C C >>> NOTE: <<< C ON RAW I/O, THIS MODULE WOULD HAVE TO BE ALTERED C TO CONTINUE READS UNTIL A COMPLETE PACKET IS RECEIVED, C SINCE AN EMBEDDED RAW VALUE WOULD PRECIPITOUSLY C TERMINATE DATA I/O. C C DO 2 N=1,80 CALL ILBYTE(IC,RBUF,N-1) IF(IC.NE.SOH.AND.POINTR.LE.0) GO TO 2; SKIP ANY PADS CALL ISBYTE(IC,SBUF,POINTR) IF(IC.EQ.MYEOL.AND.POINTR.NE.0) GO TO 3 POINTR=POINTR+1 IF(IC.NE.SOH) GO TO 2 ; UH-OH ... RESET! POINTR=1 CALL ISBYTE(IC,SBUF,0) PASS=0 2 CONTINUE C C >> UH-OH ... BAD PACKET (NO SOH OR NO EOL) C >> SEND A NAK C IER=1 PARM=' ' CALL ILBYTE(LEN,SBUF,1) LEN=LEN-32 SIZE=LEN+MYNPAD+3 IF(POINTR.LE.0.OR.PASS.NE.0) GO TO 10 IF(SIZE.LE.80.OR.LEN.GT.94) GO TO 10 PASS=PASS+1 GO TO 1 ; FINISH THE PACKET C C 3 IER=2 PASS=0 CALL ILBYTE(LEN,SBUF,1) LEN=LEN-31 CALL ILBYTE(PAKTYP,SBUF,3) PARM=PAKTYP IF(PAKTYP.EQ.ER) GO TO 14 ; DID HE SEE PROBLEMS? IF(PAKTYP.NE.SI.AND.PAKTYP.NE.FN.AND.PAKTYP.NE.DA.AND.PAKTYP. +NE.BR.AND.PAKTYP.NE.EF) GO TO 10 ; UNKNOWN PAK TYPE IER=3 PARM=NCOD(LEN-1) IF(LEN.LT.0.OR.LEN.GT.95) GO TO 10 IER=4 CALL ILBYTE(INCK,SBUF,LEN) ; GET HIS CHEKSUM OUTCK=CKSUM(SBUF) ; GET MY CHECKSUM PARM=NCOD(INCK*100+OUTCK) IF(INCK.NE.OUTCK) GO TO 10 ; IF UNEQUAL, PROBLEMS.. CALL ILBYTE(SEQNCE,SBUF,2) IER=0 PARM=' ' IF(PAKTYP.EQ.SI) CALL SETPAR(SBUF,0) IF(PAKTYP.EQ.FN) CALL OPNFIL(IER) IF(IER.NE.0) IER=IER+10 IF(PAKTYP.EQ.DA) CALL STORE IF(PAKTYP.EQ.EF.OR.PAKTYP.EQ.BR) CALL XSTORE 10 RETRY=RETRY-1 IF(IER.EQ.0) RETRY=5 COND=ACK IF(IER.EQ.0) GO TO 11 COND=NAK CALL ISBYTE(35,SBUF,1) 11 CALL ISBYTE(SOH,SBUF,0) IF(RETRY.GT.0.AND.IER.LE.4) GO TO 12 COND=ER SBUF(2)='RECV' SBUF(3)=' ERR' SBUF(4)='OR #' SBUF(5)=NCOD(IER) SBUF(6)=PARM CALL ISBYTE(55,SBUF,1) 12 CALL ILBYTE(LEN,SBUF,1) LEN=LEN-31 IF(COND.NE.ER.AND.PAKTYP.NE.SI) LEN=4 CALL ISBYTE(LEN+31,SBUF,1) CALL ISBYTE(SEQNCE,SBUF,2) CALL ISBYTE(COND,SBUF,3) CALL ISBYTE(CKSUM(SBUF),SBUF,LEN) CALL ISBYTE(YREOL,SBUF,LEN+1) LEN=LEN+2 M=YRNPAD+LEN DO 13 N=1,M IC=YRPAD IF(N.LE.LEN) CALL ILBYTE(IC,SBUF,LEN-N) 13 CALL ISBYTE(IC,SBUF,M-N) C CALL SYSIO(QBLK,33,LLU,SBUF,M,0,Y'00000000') ; SEND IT C IF(PAKTYP.EQ.BR) GO TO 15 POINTR=0 IF(IER.LE.4.AND.RETRY.GE.1) GO TO 1 14 REPORT=CONMSG(8) ; READ-PACK ERROR CALL SYSIO(PBLK,40,LLU,NCOD(IER),4,0,0) 15 CALL WAIT(3000,1,J) ; A BRIEF DELAY ... RETURN END $PROG SEND C C SUBROUTINE SEND(FLAG) IMPLICIT INTEGER(A-Z) INTEGER FLAG,NAME(3),FD(4) INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65) COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT DATA CRLF/Y'00000D0A'/ C C SEQNCE=32 C C >> PACKET TYPES; C C SI-NIT --- "S" C FN-AME --- "F" C DA-TA --- "D" C ER-ROR --- "E" C BR-EAK --- "B" C EF-ILE --- "Z" C C C >> INSURE PACKET NEVER EXCEEDS YRMAX << C YRLIM=YRMAX-3 C PAKTYP=ER BRANCH=0 BEGIN=0 CALL EXPDFD(FLAG) REWIND DIR FD(1)=RBUF(1) FD(2)=RBUF(2) FD(3)=RBUF(3) FD(4)=RBUF(4) FLAG=1 RETRY=6 ; ALLOW 5 TRIES ... CALL SYSIO(PBLK,88,DIR,RBUF,20,0,0) ; DUMMY CALL SYSIO(PBLK,88,DIR,RBUF,20,0,0) ; DUMMY REPORT=CONMSG(22) ; RETURN & RECEIVE CALL WAIT(5000,1,IER) ; ALLOW 5 SECONDS ... 1 CALL SYSIO(PBLK,72,DIR,RBUF,20,0,0) ; GET NEXT DIR ENTRY IER=IAND(PBLK(1),Y'FFFF') IF(IER.EQ.0) GO TO 2 IF(FLAG.LE.1) GO TO 3 IF(PAKTYP.EQ.BR.OR.BRANCH.NE.1) RETURN ; FINISHED ... PAKTYP=BR LEN=3 POINTR=0 CALL ISBYTE(PAKTYP,SBUF,3) BRANCH=1 ; RETURN TO 1 LGTH=1 FLAG=6 GO TO 14 2 IF(COMPFD(FD,RBUF,0).NE.1) GO TO 1 ; NOT SELECTED FLAG=5 ; SELECTED BEGIN=BEGIN+1 CALL CLOSE(FILE,IER) NAME(1)=RBUF(1) NAME(2)=RBUF(2) NAME(3)=RBUF(3) CALL OPENW(FILE,NAME,4,0,0,IER) ; ACCESS FILE ... IF(IER.LE.0) GO TO 4 3 REPORT=CONMSG(20) ; FILE ACCESS ERROR CALL SYSIO(PBLK,40,LLU,RBUF(FLAG),12,0,0) ; FNAME RETURN 4 POINTR=0 PAKTYP=SI ; BEGIN W/SINIT IF(BEGIN.GT.1) PAKTYP=FN ; -- IF FIRST OF A SET C 5 BRANCH=2 ; RETURN TO 5 IF(PAKTYP.NE.SI) GO TO 6 CALL ISBYTE(PAKTYP,SBUF,3) ; SET TYPE IN PACKET LEN=12 SEQNCE=32 PAKTYP=FN ; NEXT TYPE CALL SETPAR(SBUF,-1) ; SET UP SINIT PACKET LGTH=1 FLAG=6 GO TO 14 6 IF(PAKTYP.NE.FN) GO TO 8 LEN=3 DO 7 NB=1,12 CALL ILBYTE(IC,NAME,NB-1) CALL ISBYTE(32,SBUF,NB+3) IF(IC.LE.32.OR.IC.GT.125) GO TO 7 LEN=LEN+1 CALL ISBYTE(IC,SBUF,LEN) 7 CONTINUE CALL ISBYTE(PAKTYP,SBUF,3) ; SET TYPE IN PACKET PAKTYP=DA ; NEXT TYPE POINTR=4 LGTH=1 FLAG=6 GO TO 14 8 IF(PAKTYP.NE.EF.AND.PAKTYP.NE.BR) GO TO 9 BRANCH=1 ; RETURN TO 1 LEN=3 CALL ISBYTE(PAKTYP,SBUF,3) ; SET TYPE IN PACKET POINTR=0 ; NO MORE DATA ... LGTH=1 FLAG=6 GO TO 14 9 IF(PAKTYP.NE.DA) GO TO 24 ; ERROR PACKET ... LEN=0 CALL SYSIO(PBLK,88,FILE,DBUF,256,0,0); READ IN MAX DATA IER=IAND(PBLK(1),Y'FFFF') CALL ISBYTE(PAKTYP,SBUF,3) ; WAS DATA ... IF(IER.EQ.0) GO TO 11 PAKTYP=EF ; FLAG END-OF-DATA IF(POINTR.LE.4) GO TO 8 LGTH=1 FLAG=6 GO TO 14 11 LGTH=PBLK(5) FLAG=0 IF(MODE.NE.0) GO TO 14 ; ALL OUT FOR BINARY M=LGTH LGTH=0 DO 12 N=1,M CALL ILBYTE(IC,DBUF,N-1) IC=IAND(IC,127) ; IF ASCII - MAX=127 IF(IC.GT.32) LGTH=N IF(IC.LT.32) GO TO 13 12 CONTINUE 13 LGTH=LGTH+2 CALL ISBYTE(13,DBUF,LGTH-2) ; CR CALL ISBYTE(10,DBUF,LGTH-1) ; LF 14 DO 23 N=1,LGTH IF(FLAG.EQ.6) GO TO 17 CALL ILBYTE(DATUM,DBUF,N-1) IF(DATUM.LE.127.OR.QUOT8B.EQ.0) GO TO 15 CALL ISBYTE(YRFG0,SBUF,POINTR) POINTR=POINTR+1 DATUM=FLIPB0(DATUM) 15 JC=IAND(DATUM,Y'7F') IF(JC.GE.32.AND.JC.LE.126.AND.JC.NE.YRCTL.AND.JC.NE.YRFG0) + GO TO 16 IF(YRCTL.EQ.NAK) GO TO 16 ; ON "N" USE RAW ... IF(JC.EQ.YRFG0.AND.QUOT8B.EQ.0) GO TO 16 CALL ISBYTE(YRCTL,SBUF,POINTR) POINTR=POINTR+1 IF(DATUM.NE.YRCTL.AND.DATUM.NE.YRFG0) + DATUM=CTL(JC) 16 CALL ISBYTE(DATUM,SBUF,POINTR) POINTR=POINTR+1 BRANCH=3 ; RETURN TO 23 IF(POINTR.LT.YRLIM) GO TO 23 17 IF(LEN.LE.0.AND.POINTR.LE.4) GO TO 22 CALL ISBYTE(SOH,SBUF,0) IF(POINTR.GT.4) LEN=POINTR-1 CALL ISBYTE(LEN+32,SBUF,1) CALL ISBYTE(SEQNCE,SBUF,2) CALL ISBYTE(CKSUM(SBUF),SBUF,LEN+1) CALL ISBYTE(YREOL,SBUF,LEN+2) LEN=LEN+3 IF(YRNPAD.LT.1) GO TO 19 L=LEN+YRNPAD DO 18 M=1,L IC=YRPAD IF(M.LE.LEN) CALL ILBYTE(IC,SBUF,LEN-M) 18 CALL ISBYTE(IC,SBUF,L-M) LEN=LEN+YRNPAD 19 CALL SYSIO(PBLK,33,LLU,SBUF,LEN,0,0); SEND IT OFF POINTR=4 CALL SYSIO(RBLK,73,CLU,RBUF,200,0,Y'18000000') ; GET RESP PTR=0 20 CALL ILBYTE(KC,RBUF,PTR) PTR=PTR+1 IF(KC.NE.SOH.AND.PTR.LT.100) GO TO 20 IF(KC.NE.SOH) GO TO 25 CALL ILBYTE(JC,RBUF,PTR+1) ; GET SEQNCE CALL ILBYTE(KC,RBUF,PTR+2) ; GET RESPONSE IF(KC.EQ.ACK.AND.JC.EQ.SEQNCE) GO TO 21 CALL WAIT(500,1,IER) ; WAIT BEFORE RETRY RETRY=RETRY-1 IF(RETRY.GT.0) GO TO 19 ; TRY AGAIN CALL WAIT(5000,1,IER) ; GIVE UP ... REPORT=CONMSG(23) ; SEND ERROR IF(KC.EQ.ER) GO TO 24 RETURN 21 SEQNCE=SEQNCE+1 IF(SEQNCE.GT.95) SEQNCE=32 RETRY=6 IF(PAKTYP.EQ.FN) CALL SETPAR(RBUF,PTR-1) ; HIS REPLY TO SI 22 GO TO (1,5,23),BRANCH 23 CONTINUE GO TO 5 ; NEXT DBUF ... C 24 CALL ILBYTE(LEN,RBUF,1) ; LENGTH OF ERR PACKET LEN=LEN-30 REPORT=CONMSG(24) ; REPORT EPACK IF(LEN.GT.0) CALL SYSIO(PBLK,41,LLU,RBUF(2),LEN,0,0) 25 RETURN END $PROG SETPAR C C SUBROUTINE SETPAR(BUFF,CODE) IMPLICIT INTEGER (A-Z) INTEGER BUFF(1),CODE C C >> ON CODE = 0; WE'RE RECEIVING - GOT HIS - TELL HIM OURS C < 0; SET OUR PARAMS FOR SEND INIT TO CALLER C > 0; WE'RE SENDING - GOT HIS - MATCH THINGS UP C COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT IF(CODE.LT.0) GO TO 1 CALL ILBYTE(YRMAX,BUFF,4+CODE) YRMAX=YRMAX-32 CALL ILBYTE(YRTIM,BUFF,5+CODE) YRTIM=YRTIM-32 CALL ILBYTE(YRNPAD,BUFF,6+CODE) YRNPAD=YRNPAD-32 CALL ILBYTE(YRPAD,BUFF,7+CODE) YRPAD=CTL(YRPAD) CALL ILBYTE(YREOL,BUFF,8+CODE) YREOL=YREOL-32 CALL ILBYTE(YRCTL,BUFF,9+CODE) CALL ILBYTE(YRFG0,BUFF,10+CODE) CALL ILBYTE(YRCKT,BUFF,11+CODE) YRCKT=YRCKT-48 CALL ILBYTE(YRRPT,BUFF,12+CODE) 1 CALL ISBYTE(MYMAX+32,BUFF,4) CALL ISBYTE(MYTIM+32,BUFF,5) CALL ISBYTE(MYNPAD+32,BUFF,6) CALL ISBYTE(CTL(MYPAD),BUFF,7) CALL ISBYTE(MYEOL+32,BUFF,8) CALL ISBYTE(MYCTL,BUFF,9) IF(YRFG0.EQ.ACK) YRFG0=MYFG0 ; "Y" MEANS "YOURS" IF(MYFG0.NE.YRFG0.AND.YRFG0.NE.ACK) QUOT8B=0 J=32 IF(CODE.LT.0) J=ACK ; OKAY BY US .. IF(QUOT8B.NE.0) J=MYFG0 CALL ISBYTE(J,BUFF,10) CALL ISBYTE(49,BUFF,11) ; 1 CALL ISBYTE(MYRPT,BUFF,12) ; N C CALL ISBYTE(44,BUFF,1) C RETURN END $PROG STATUS C C SUBROUTINE STATUS IMPLICIT INTEGER (A-Z) INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65) COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT NONE='NONE' IF(LLU.NE.1) RETURN ; INTERACTIVE ONLY REPORT=CONMSG(1) ; CLEAR SCREEN REPORT=CONMSG(9) ; STATUS BANNER REPORT=CONMSG(10) ; SOH MESSG CALL SYSIO(PBLK,40,LLU,NCOD(SOH),4,0,0) ; SOH VALUE REPORT=CONMSG(11) ; EOL MESSG CALL SYSIO(PBLK,40,LLU,NCOD(MYEOL),4,0,0) ; EOL VALUE REPORT=CONMSG(12) ; PACKET MESSG CALL SYSIO(PBLK,40,LLU,NCOD(MYMAX),4,0,0) ; MYMAX VALUE REPORT=CONMSG(13) ; MYNPAD MESSG CALL SYSIO(PBLK,40,LLU,NCOD(MYNPAD),4,0,0) ; MYNPAD VALUE REPORT=CONMSG(14) ; MYPAD MESSG CALL SYSIO(PBLK,40,LLU,NCOD(MYPAD),4,0,0) ; MYPAD REPORT=CONMSG(15) ; MYCTL MESSG CALL SYSIO(PBLK,40,LLU,MYCTL,4,0,0) ; MYCTL VALUE REPORT=CONMSG(16) ; MYFG0 MESSG J=MYFG0 IF(QUOT8B.LE.0) J='OFF ' CALL SYSIO(PBLK,40,LLU,J,4,0,0) ; MYFG0 VALUE REPORT=CONMSG(17) ; RECORD MESSG CALL SYSIO(PBLK,40,LLU,NCOD(RECORD),4,0,0) ; RECORD VALUE RBUF(1)='ASCI' RBUF(2)='I ' IF(MODE.LE.0) GO TO 1 RBUF(1)='BINA' RBUF(2)='RY ' 1 REPORT=CONMSG(18) ; MODE MESSAGE CALL SYSIO(PBLK,40,LLU,RBUF,6,0,0) ; MODE VALUE REPORT=CONMSG(19) ; PARITY MESSG CALL SYSIO(PBLK,40,LLU,NONE,4,0,0) ; PARITY VALUE RETURN END $PROG STORE C C SUBROUTINE STORE C C >> DECODES A RECEIVED PACKET FROM SBUF INTO DBUF C >> - FOR ASCII FILES (QUOT8B - <= 0), C >> OR BYTE COUNT => RECORD, CAUSES I/O TO LU #2. C C >> NOTE: CALL TO XSTORE AFTER RECEIV COMPLETION C >> IS REQUIRED TO FLUSH FINAL RECORD (IF ANY). C IMPLICIT INTEGER (A-Z) INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65) COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD, +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL, +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT DATA POINTR,CRLF/0,Y'00000D0A'/ C DATA FLAG1,FLAG0,LAST/0,0,0/ C CALL ILBYTE(LEN,SBUF,1) LEN=LEN-32 WFLAG=0 DO 4 N=4,LEN CALL ILBYTE(IC,SBUF,N) IF(IC.NE.MYFG0) GO TO 1 IF(FLAG1.NE.0.OR.QUOT8B.EQ.0) GO TO 3 ; "&" OR "#&" FLAG0=1 ; RECEIVED "QUOTE" GO TO 4 1 IF(IC.NE.MYCTL) GO TO 2 IF(FLAG1.NE.0.OR.MYCTL.EQ.NAK) GO TO 3 ; "##" OR "#"/RAW FLAG1=1 ; RECEIVED "CTL" GO TO 4 2 IF(FLAG0.NE.0) IC=FLIPB0(IC) ; SET BIT 0 IF(FLAG1.NE.0) IC=CTL(IC) ; SET BIT 1 3 IF(MODE.EQ.0) IC=IAND(IC,Y'7F') ; STRIP BIT 0 CALL ISBYTE(IC,DBUF,POINTR) ; PLACE IN BUFFER POINTR=POINTR+1 IC=IAND(IC,127) FLAG0=0 FLAG1=0 CALL ILBYTE(JC,LAST,3) CALL ISBYTE(IC,LAST,3) CALL ISBYTE(JC,LAST,2) IF(POINTR.GE.RECORD) WFLAG=1 IF(LAST.EQ.CRLF.AND.MODE.EQ.0) WFLAG=1 IF(WFLAG.EQ.0) GO TO 4 K=33 ; IMAGE WRITE & PROCEED IF(MODE.LE.0) K=32 ; ASCII WRITE & PROCEED IF(LAST.EQ.CRLF.AND.MODE.EQ.0) POINTR=POINTR-2 IF(POINTR.GT.0) CALL SYSIO(RBLK,K,FILE,DBUF,POINTR,0,0) POINTR=0 IF(WFLAG.GT.1) RETURN WFLAG=0 4 CONTINUE RETURN C ENTRY XSTORE ; CLEAN UP SHOP C FLAG1=0 FLAG0=0 LAST=0 C K=33 ; IMAGE WRITE & PROCEED IF(MODE.LE.0) K=32 ; ASCII WRITE & PROCEED IF(LAST.EQ.CRLF.AND.MODE.EQ.0) POINTR=POINTR-2 IF(POINTR.GT.0) CALL SYSIO(RBLK,K,FILE,DBUF,POINTR,0,0) POINTR=0 RETURN END $BEND