C TAPE POSITION CONTROLLER AND 80-BYTE/RECORD DATA COPIER INTEGER*2 IPTRS DIMENSION IPTRS(4),IDESC(7) DIMENSION LINE(80,10) BYTE LINE BYTE AA,BB BYTE CCC 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,3HTPC,MCRSZ,72) IRECCT=0 CALL FFINIT(IPTRS,LINE,MCRSZ,IERR) CALL FFSTR(IPTRS,JJJ,2) D JJJJ=JJJ 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 =A,CHARAC ALTER TAPE CHARAC TO VALUE CHARAC 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.'H') GO TO 4592 C WRITE HELP MESSAGE WRITE (5,4591) 4591 FORMAT(' CMD UNIT COUNT,EXTRA INFO ',/, 1' CMD=R REWIND UNIT',/, 2' =E WRITE EOF ON UNIT',/, 3' =S SKIP COUNT RECORDS (+ OR -)',/, 4' =F SKIP COUNT FILES (+ OR -)',/, 5' =C COPY PDP11 FILE TO TAPE IN ASCII, BLK FACTOR=COUNT',/, 6' =W WRITE TAPE FILE TO DISK IN ASCII,BLK FACTOR=COUNT',/, 7' =P WRITE PDP11 FILE TO TAPE IN EBCDIC, BLK FAC=COUNT',/, 8' =I INPUT EBCDIC FILE TAPE TO PDP11, BLK FAC. = COUNT',/, 9' =A ALTER TAPE CHARAC. TO COUNT',/, 1' =X EXIT',/, 2' =H PRINT THIS MESSAGE',/,/ 3' UNIT = 0 OR 1 FOR MT0: OR MT1:',/, 4' COUNT, EXTRA=EXTRA NUMERIC INFORMATION AS REQUIRED') 4592 CONTINUE IF (ICMD.NE.'A') GO TO 5566 C ALTER CHARACTERISTICS OF TAPE CALL FFINTG(IPTRS,ICHARA) CALL MSETCH(ICHARA) 5566 CONTINUE 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.'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 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