C TAPE POSITION CONTROLLER AND 80-BYTE/RECORD DATA COPIER INTEGER*2 IPTRS DIMENSION IPTRS(4),IDESC(7) DIMENSION LINE(80,10) DIMENSION LLINE(2800) BYTE LINE,LLINE EQUIVALENCE (LINE(1,1),LLINE(1)) BYTE AA,BB BYTE CCC DIMENSION OLINE(132) BYTE OLINE DIMENSION CCC(2) EQUIVALENCE (AA,CCC(1)),(BB,CCC(2)) EQUIVALENCE (JJJ,CCC(1)) INTEGER * 4 IRECCT C DO TAPE OPERATIONS 100 CALL GETCML(LINE,3HDGT,MCRSZ,72) IRECCT=0 CALL FFINIT(IPTRS,LINE,MCRSZ,IERR) CALL FFSTR(IPTRS,JJJ,2) BB=32 ICMD=JJJ CALL FFINTG(IPTRS,IUNIT) C FREE FORMAT COMMANDS: C LETTER,NUMBER[,NUMBER] C WHERE C LETTER=R,REWIND UNIT (0 OR 1) C =E, WRITE ENDFILE ON UNIT 0 OR 1 C =S, SKIP +- N RECORDS ON UNIT 0 OR 1 C =F, SKIP +- N FILES ON UNIT 0 OR 1 C =C, COPY PDP11 FILE TO TAPE C =W, WRITE TAPE FILE TO DISK. C =P, COPY PDP11 FIILE TO TAPE IN EBCDIC FOR PUNCH C =I, COPY TAPE FILE TO PDP11, TAPE IN EBCDIC C =G, GET DG FORMAT TAPE FILE, DUMP TO PDP11 C (200 BIT CLEARED ON INPUT IN ALL BYTES) C =O, OUTPUT TAPE WITH RECORDS TERMINATED BY C.R. C O UNIT,BLKFACTOR,FLAG (FLAG=1 MEANS SET 200 C BIT IN ALL OUTPUT CHARS, =ANYTHING ELSE C MEANS LEAVE 200 BIT OFF ALWAYS. C =U, READ IN LIKE G EXCEPT BIG RECORDS A LA UNIVAC JUNK IEBFLG=0 C IF EBCDIC, SET IEBFLG NONZERO. CALL ALUN(IUNIT) C ASSIGN 'MAGLUN' (GLOBAL) TO MT0: OR MT1: IF (ICMD.EQ.'X') CALL EXIT IF (ICMD.NE.'I') GO TO 6770 IRECCT=0 IEBFLG=1 GO TO 6775 6770 CONTINUE IF (ICMD.NE.'P') GO TO 6769 IRECCT=0 IEBFLG=1 GO TO 6774 6769 CONTINUE IF (ICMD.NE.'O') GO TO 7330 C OUTPUT DATA TERMINATED BY C.R. ONLY CALL FFINTG(IPTRS,IBLKF) IF (IBLKF.LE.0)IBLKF=1 IF (IBLKF.GT.10)IBLKF=10 C OUTPUT 0,1 FOR 1 72 CHAR RECORD. A 3RD PARAMETER WILL SEE IF C WE NEED TO SET 200 BIT IN WHOLE RECORD IBITST=0 CALL FFINTG(IPTRS,IBITST) C IF WE SEE OUTPUT 0,1,1 THEN SET BIT. OTHER VALUES LEAVE IT OFF. CALL GETCML(LINE,3HDGO,MCRSZ,72) CALL ASSIGN(3,LINE,MCRSZ) ITXTI=1 7329 CONTINUE ITXTI=1 ITXTI2=ITXTI+68 DO 7328 IREC=1,IBLKF READ(3,102,END=7327,ERR=7327)(LLINE(IIII),IIII=ITXTI,ITXTI2) LLINE(ITXTI2+1)=13 ITXTI=ITXTI+70 ITXTI2=ITXTI2+70 7328 CONTINUE NWRTB=72*IBLKF LLINE(NWRTB+1)=0 C NO. BYTES IN 3 RECORDS (INCLUDING 3 C.R. CHARACTERS), +1 TO MAKE EVEN IF (IBITST.EQ.1)CALL SET8(LINE,NWRTB) CALL MWRITE(LINE,NWRTB,NFLAG) CALL ERFLG(NFLAG,NFLAG) IF (NFLAG.EQ.6.OR.NFLAG.EQ.1.OR.NFLAG.EQ.3 1 .OR.NFLAG.EQ.2)GOTO 10005 GO TO 7329 7327 CONTINUE C ENDFILE SEEN...CLOSE AND GO AWAY CALL CLOSE(3) GO TO 10005 7330 CONTINUE IF (ICMD.EQ. 'U') GOTO 6399 IF (ICMD.NE.'G') GO TO 6300 C GET DG TAPE DATA (RECORDS TERMINATED BY C.R.) C C NOTE: FORMAT OF DATA GENERAL (RDOS) TAPES IS C 255 WORDS DATA CHARACTERS C 1 WORD FILE NUMBER (0-99=LEGAL RANGE) C 1 WORD FILE NUMBER (0-99=LEGAL RANGE) C TOTAL 257 WORDS IUUUU=0 GO TO 6398 6399 CONTINUE IUUUU=1 6398 CONTINUE C CALL GETCML(LINE,3HDGI,MCRSZ,72) CALL ASSIGN(3,LINE,MCRSZ) ITXTO=1 6299 CONTINUE C READ TAPE, THEN OUTPUT TO PDP11 WITH RECORD BOUNDARIES AT C.R. ITXTI=1 CALL MREAD(LINE,2800,NREAD,MFLAG) CALL ERFLG(MFLAG,MFLAG) IF (MFLAG.EQ.6.OR.MFLAG.EQ.1.OR.MFLAG.EQ.3.OR.MFLAG.EQ.2)GOTO 98 C REMOVE H.O. BIT FROM ALL TEXT BYTES... CALL OFF8(LINE,NREAD) C NREAD=NUMBER BYTES FOUND IN BUFFER C COPY DATA TO OLINE UNTIL: C 1. A C.R. CHAR IS ENCOUNTERED IN OUTPUT, OR C 2. TAPE DATA IS EXHAUSTED C THROW OUT CONTROL CHARACTERS (ZERO FILL) C C THE FOLLOWING WILL ENSURE ONLY 255 WORDS (510 BYTES) ARE USED AS TEXT IF (IUUUU.NE.1)NREAD=510 C 97 CONTINUE ISAVE=LLINE(ITXTI) ITXTI=ITXTI+1 IF (ISAVE.EQ.13) GO TO 96 C 96 IS TO EMIT LINE. OTHERWISE NOT DONE LINE YET, SO SAVE CHAR C AFTER PRINTABILITY CHECK AND GO ON C **** C FORMFEED KLUDGE C **** C IF (ISAVE.NE.12) GO TO 5252 C FORMFEED IN INPUT. REMOVE IT AND OUTPUT A FORM FEED 5251 FORMAT(1H1) C FLUSH OUT ANY OUTPUT UP TO HERE AND THEN EMIT THE FORMFEED IF (ITXTO.GT.1)WRITE (3,94)(OLINE(I95),I95=1,ITXTO) ITXTO=1 ITXTI=ITXTI-1 LLINE(ITXTI)=32 WRITE(3,5251) GO TO 5250 5252 CONTINUE C C **** C END OF FORMFEED KLUDGE C **** IF (((ISAVE.NE.9).AND.(ISAVE.NE.12)).AND. 1 ((ISAVE.LT.32).OR.(ISAVE.GT.127))) ISAVE=0 OLINE(ITXTO)=ISAVE IF (ITXTO.LT.130)ITXTO=ITXTO+1 IF (ITXTI.LT.NREAD) GO TO 97 C READ MORE TAPE IF WE MUST, TO GET NEXT PART OF LINE GO TO 6299 96 CONTINUE C HERE EMIT OUTPUT LINE AND CLEAR ITXTO POINTER WRITE (3,94)(OLINE(I95),I95=1,ITXTO) 94 FORMAT(1X,131A1) ITXTO=1 5250 DO 95 I95=1,132 OLINE(I95)=0 95 CONTINUE C WHEN DONE WRITING THIS RECORD, GO TRY FOR MORE. GO TO 97 98 CALL CLOSE(3) GO TO 10005 6300 CONTINUE IF (ICMD.NE.'W') GO TO 7776 C WRITE PDP11 FILE FROM TAPE FILE. USER GIVES NAME. IRECCT=0 6775 CALL FFINTG(IPTRS,IBKFAC) IF (IBKFAC.LT.1)IBKFAC=1 IF (IBKFAC.GT.10)IBKFAC=10 CALL GETCML(LINE,3HINP,MCRSZ,72) CALL ASSIGN(3,LINE,MCRSZ) 112 CONTINUE CALL MREAD(LINE,800,NREAD,MFLAG) CALL ERFLG(MFLAG,MFLAG) IF (MFLAG.EQ.6.OR.MFLAG.EQ.1.OR.MFLAG.EQ.3.OR.MFLAG.EQ.2)GOTO 115 C TRANSLATE EBCDIC TO ASCII IRECCT=IRECCT+1 DO 3001 ICNT=1,IBKFAC IF (IEBFLG.NE.0)CALL EA(LINE(1,ICNT),LINE(1,ICNT),80) WRITE(3,122)(LINE(III,ICNT),III=1,80) 122 FORMAT(1X,80A1) 3001 CONTINUE GO TO 112 115 CONTINUE WRITE(5,7676)IRECCT 7676 FORMAT(' TPC-- ',I10,' RECORDS PROCESSED') CALL CLOSE(3) GO TO 10005 7776 CONTINUE IF (ICMD.NE.'C') GO TO 7777 C COPY FILE. GET PDP11 FILE SPECS FIRST. IRECCT=0 6774 CONTINUE CALL FFINTG(IPTRS,IBKFAC) IF (IBKFAC.LT.1)IBKFAC=1 IF (IBKFAC.GT.10)IBKFAC=10 CALL GETCML(LINE,3HWRT,MCRSZ,72) C READ IN FILE SPECS. CALL ASSIGN(3,LINE,MCRSZ) CALL FDBSET(3,'READONLY','SHARE') C SET UP ONLY READ ACCESS NEEDED FOR FILE. C WRITE 1ST RECORD=FILE NAME SPECS C GO TO 110 101 CONTINUE DO 3002 ICNT=1,IBKFAC READ(3,102,END=103,ERR=105)(LINE(III,ICNT),III=1,80) 102 FORMAT(80A1) 110 CONTINUE C TRANSLATE ASCII TO EBCDIC IF (IEBFLG.NE.0)CALL AE(LINE(1,ICNT),LINE(1,ICNT),80) 3002 CONTINUE IRECCT=IRECCT+1 CALL MWRITE(LINE,80*IBKFAC,NFLAG) CALL ERFLG(NFLAG,NFLAG) IF (NFLAG.EQ.3.OR.NFLAG.EQ.6) GO TO 105 GO TO 101 103 CONTINUE WRITE(5,7676)IRECCT IF (IBKFAC.EQ.1) GO TO 3004 CALL MWRITE(LINE,80*IBKFAC,NFLAG) CALL ERFLG(NFLAG,NFLAG) 3004 CONTINUE C READ TO END-OF-FILE C WRITE 2 EOF ON TAPE AND BACKSPACE OVER ONE OF THEM. CALL MEOF(2) CALL MSKIPR(-1) C THAT DOES IT. CALL CLOSE(3) GO TO 10005 105 CONTINUE WRITE (5,106) 106 FORMAT(' TPC--WRITE ERROR FOR SOME REASON--OPERATION ABORTED.') CALL CLOSE(3) GO TO 10005 7777 CONTINUE IF (ICMD.NE.'R') GO TO 1000 C REWIND TAPE CALL MREWIN GO TO 10000 1000 CONTINUE IF (ICMD.NE.'E') GO TO 2000 C WRITE AN EOF ON TAPE CALL MEOF(1) GO TO 10000 2000 CONTINUE IF (ICMD.NE.'S') GO TO 3000 C SKIP RECORDS. GET RECORD COUNT FROM STRING CALL FFINTG(IPTRS,NRECS) CALL MSKIPR(NRECS) GO TO 10000 3000 IF (ICMD.NE.'F') GO TO 12000 C SKIP FILES. GET FILE COUNT FROM STRING. CALL FFINTG(IPTRS,NRECS) CALL MSKIPF(NRECS) 10000 CONTINUE C HERE HAVE DONE A TAPE I/O OP. TEST STATUS. CALL MSTAT(JERR) C DECODE ERRORS CALL ERFLG(JERR,JERR) IF (JERR.LE.0) GO TO 12000 IF (JERR.EQ.6) WRITE (5,12001)IUNIT IF (JERR.NE.6) WRITE (5,12002)IUNIT 12002 FORMAT(' TPC -- I/O ERROR ON UNIT MT',I1,': -OPERATION ABORTED') 12001 FORMAT(' TPC -- TAPE UNIT MT',I1,': UNMOUNTED') 12000 CONTINUE D WRITE (5,7000)JJJJ,IUNIT,NRECS D7000 FORMAT(' ICMD=',A2,' IUNIT= ',I4,'NRECS= ',I4 ) 10005 GO TO 100 END